Commits

Anonymous committed c7fa5c8

sorted arrays: moved to cadastr

Comments (0)

Files changed (2)

src/sortedArray.ml

-(* реализация пока очень дубовая, но использует уже написанный код. *)
-
-module S = SortedArraySet.SortedArraySet
-;
-
-type t 'k = S.t 'k ('k * int)
-;
-
-value (create : ('k -> 'k -> int) -> array 'k -> t 'k) cmpf src =
-(*
-  let cmpf' = fun (a, _ai) (b, _bi) -> cmpf a b in
-*)
-  let src_copied = Array.copy src in
-  let () = Array.sort cmpf src_copied in
-  let src_copied_indexed = Array.mapi (fun i x -> (x, i)) src_copied in
-  let r = S.create fst cmpf in
-  ( S.replace_with_array r src_copied_indexed
-  ; r
-  )
-;
-
-value (lookup_index_opt : t 'k -> 'k -> option int) a k =
-  match S.lookup_opt a k with
-  [ None -> None
-  | Some (_k, i) -> Some i
-  ]
-;
-
-
-value get_keys = S.get_keys
-;

src/sortedArraySet.ml

-type cmpf 'k = 'k -> 'k -> int
-;
-
-
-module SortedArraySet
- :
-  sig
-
-    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 get_keys : t 'k 'v -> array 'k
-    ;
-
-  end
- =
-  struct
-
-    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) }
-              ]
-    ;
-
-
-    value get_keys a =
-      let items = a.items
-      and key = a.key in
-      Array.init a.count (fun i -> key items.(i))
-    ;
-
-  end
-;