cadastr / src / cd_SortedArraySet.ml

module SortedArraySet
 :
  sig

    type cmpf 'k = 'k -> 'k -> int
    ;

    type t 'k 'v
    ;

    value create : ('v -> 'k) -> cmpf 'k -> t 'k 'v
    ;

    (* True if operation was successful. *)
    value add : t 'k 'v -> 'v -> bool
    ;

    (* True if operation was successful. *)
    value remove : t 'k 'v -> 'v -> bool
    ;

    (* True if exists. *)
    value mem : t 'k 'v -> 'v -> bool
    ;

    value mem_by_key : t 'k 'v -> 'k -> bool
    ;

    value lookup_opt : t 'k 'v -> 'k -> option 'v
    ;

    value fold : ('a -> 'k -> 'v -> 'a) -> 'a -> t 'k 'v -> 'a
    ;

    value replace_with_array : t 'k 'v -> array 'v -> unit
    ;

    value iter_diff :
      ?only_first : ('k -> 'v1 -> unit) ->
      ?only_second : ('k -> 'v2 -> unit) ->
      ?both : ('k -> 'v1 -> 'v2 -> unit) ->
      ~first : (t 'k 'v1) ->
      ~second : (t 'k 'v2)
      -> unit
    ;

    value intersects : t 'k 'v1 -> t 'k 'v2 -> bool
    ;

    value get_keys : t 'k 'v -> array 'k
    ;

  end
 =
  struct

    type cmpf 'k = 'k -> 'k -> int
    ;

    type t 'k 'v =
      { count : mutable int
      ; items : mutable array 'v
      ; key : 'v -> 'k
      ; compare : cmpf 'k
      }
    ;

    (* в items так:
      - или Array.length items = count, и items = все элементы,
      - или count = 0 и Array.length items = 0, и ни одного элемента,
      - или Array.length items > count и items.(count .. length-1) == items.(0)
     *)


    value enlarge_factor = 2
          (* enlarge array from N to N*enlarge_factor when the enlargement
             is needed. *)
      and sortedarray_min_size = 16
          (* array won't be smaller than sortedarray_min_size. *)
      and shrink_factor = 8
          (* array will be shrunk when count will be less-or-equal
             to size/shrink_factor (if this value is not lesser than
             sortedarray_min_size). *)
    ;


    value create key cmpf =
      { count = 0
      ; key = key
      ; items = [| |]
      ; compare = cmpf
      }
    ;


    (* if result < 0 then (lnot result) is the index
         where the item should be placed when inserting.
       else result is the index of found item.
     *)
    value binary_search itmkey sa =
      let len = sa.count
      and arr = sa.items
      and cmp = sa.compare
      and key = sa.key in
      let () = assert (0 <= len && len < max_int) in
      inner 0 len
      where rec inner lo hi =
        if lo = hi
        then lnot lo
        else
          let mid = (lo + hi) / 2 in
          match (cmp itmkey (key arr.(mid))) with
          [ 0 -> mid
          | r when r < 0 (* itm < arr.(mid) *) -> inner lo mid
          | _ (* itm > arr.(mid) *) -> inner (mid+1) hi
          ]
    ;

    value insert sa ind itm =
      let count = sa.count
      and arr = sa.items in
      let () = assert (ind >= 0 && ind <= count) in
      let arr_len = Array.length arr in do
        { if count < arr_len
          then do
            { Array.blit arr ind arr (ind+1) (count - ind)
            }
          else do
            { let new_arr = Array.make
                (max (count * enlarge_factor) sortedarray_min_size)
                (if count = 0 then itm else arr.(0)) in
              do
                { ()
                ; Array.blit arr 0 new_arr 0 ind
                ; (*if ind < count
                  then*) Array.blit arr ind new_arr (ind+1) (count - ind)
(*
                  else () (* else there would be Invalid_argument("Array.blit") *)
*)
                ; sa.items := new_arr
                }
            }
        ; sa.items.(ind) := itm
        ; sa.count := count + 1
        }
    ;

    value add sa itm =
      let r = binary_search (sa.key itm) sa in
      if r < 0
      then do { insert sa (lnot r) itm; True }
      else False
    ;

    value do_shrink sa new_len =
      let old_items = sa.items
      and count = sa.count in
      let old_len = Array.length old_items in
      let () = assert (count <= new_len && new_len < old_len) in
      let new_items = Array.make new_len old_items.(0) in
      let () = Array.blit old_items 1 new_items 1 (count-1) in
      sa.items := new_items
    ;

    value do_remove sa ind =
      let count = sa.count in
      let new_count = count - 1 in
      let () = assert (ind >= 0 && ind < count) in do
        { if new_count = 1
          then
            sa.items := [| |]
          else do
            { let newlen = (Array.length sa.items) / shrink_factor in
              if newlen > sortedarray_min_size
              && new_count <= newlen
              then
                let () = assert (not (new_count < newlen))
                (* т.к. уменьшаем длину sa.items только тут. *)
                in
                  do_shrink sa newlen
              else ()
            ;
              Array.blit
                sa.items (ind + 1)
                sa.items ind
                (new_count - ind)
            }
        ; sa.count := new_count
        }
    ;

    value remove sa itm =
      let r = binary_search (sa.key itm) sa in
      if r < 0
      then False
      else do { do_remove sa r; True }
    ;

    value mem_by_key sa itmkey =
      ((binary_search itmkey sa) >= 0)
    ;

    value mem sa itm =
      mem_by_key sa (sa.key itm)
    ;

    value lookup_opt sa k =
      let i = binary_search k sa in
      if i < 0
      then None
      else Some (sa.items.(i))
    ;

    value fold func init sa =
      let cnt = sa.count
      and items = sa.items
      and key = sa.key in
      inner init 0
      where rec inner acc i =
        if i = cnt
        then
          acc
        else
          let itm = items.(i) in
          inner (func acc (key itm) itm) (i+1)
    ;

    value replace_with_array sa a =
      let new_items = Array.copy a in
      let cmp = sa.compare
      and key = sa.key in do
        { Array.sort
            (fun a b -> cmp (key a) (key b))
            new_items
        ; sa.count := Array.length new_items
        ; sa.items := new_items
        }
    ;


    value ignore2 _ _ = ()
      and ignore3 _ _ _ = ()
    ;

    value iter_diff
      ?only_first
      ?only_second
      ?both
      ~first ~second
      =
        let cmp = first.compare in
        if cmp != second.compare
        then failwith "SortedArraySet.iter_diff: sorry, one small limitation."
        else
        let nvl opt dflt =
          match opt with
          [ None -> dflt
          | Some v -> v
          ] in
        (* фокус затеян затем, чтобы можно было потом оптимизировать
           разные случаи необходимости вызова итерационных функций
           (например, когда указано только both, алгоритм может стать
           быстрее). *)
        let only_first = nvl only_first ignore2
        and only_second = nvl only_second ignore2
        and both = nvl both ignore3 in
        let c1 = first.count
        and c2 = second.count
        and it1 = first.items
        and it2 = second.items
        and k1 = first.key
        and k2 = second.key
        and iter_range itf kf arr ifrom ito =
          for i = ifrom to ito do
            { let v = arr.(i) in itf (kf v) v
            }
        in
        inner 0 0
        where rec inner i j =
          if i = c1
          then
            if j = c2
            then
              (* here: i=c1, j=c2. *)
              ()
            else
              (* here: i=c1, j<c2. *)
              iter_range only_second k2 it2 j (c2 - 1)
          else
            if j = c2
            then
              (* here: i<c1, j=c2. *)
              iter_range only_first k1 it1 i (c1 - 1)
            else
              (* here: i<c1, j<c2. *)
              let v1 = it1.(i) in
              let k1 = k1 v1 in
              let v2 = it2.(i) in
              let k2 = k2 v2 in
              match (cmp k1 k2) with
              [ 0 -> (* k1 = k2 *)
                  do { both k1 v1 v2; inner (i+1) (j+1) }
              | x when x<0 -> (* k1 < k2 *)
                  do { only_first k1 v1; inner (i+1) j }
              | _ (* when x>0 *) -> (* k1 > k2 *)
                  do { only_second k2 v2; inner i (j+1) }
              ]
    ;


    exception Intersects
    ;


    value intersects first second =
      try
        ( iter_diff
            ~both:(fun _k _v1 _v2 -> raise Intersects)
            ~first ~second
        ; False
        )
      with
      [ Intersects -> True ]
    ;


    value get_keys a =
      let items = a.items
      and key = a.key in
      Array.init a.count (fun i -> key items.(i))
    ;

  end
;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.