Commits

Dmitry Grebeniuk  committed dd4fa58

merge_trie written+tested

  • Participants
  • Parent commits 1e6b895

Comments (0)

Files changed (2)

File src/cadastr.ml

       object
         inherit map_rwm [list 'k, 'v];
         (* + fold_levels *)
+
+        (* [t1#merge_trie func t2] merges tries [t1] and [t2], replacing
+           each node's bindings with result of
+           [func rev_key_path t1bindings t2bindings], where
+           [rev_key path] is the reversed path to the node from the
+           tries' roots, [tNbindings] are bindings of [tN] (top-level
+           bindings first), and the result is the new bindings for
+           this node (top-level bindings first).
+         *)
+        method merge_trie
+        : (list 'k -> list 'v -> list 'v -> list 'v) -> trie 'k 'v
+        ;
+
       end
     ;
 
 
     (*****************************************************)
 
+
     class trie ['k, 'v]
     (node_list : list 'v)
     (level : Tfun.map_rws 'k (trie 'k 'v)) =
       object (self)
 
+        method get_root_node = node_list;
+        method get_level = level;
+
         method empty = new trie [] level#empty;
         method is_empty = ((node_list = []) && level#is_empty);
 
+        method merge_levels
+        : (list 'k -> list 'v -> list 'v -> list 'v)
+          -> list 'k
+          -> Tfun.map_rws 'k (trie 'k 'v)
+          -> Tfun.map_rws 'k (trie 'k 'v)
+          -> Tfun.map_rws 'k (trie 'k 'v)
+        = fun merge_node kr l1 l2 ->
+            l1#merge
+              (fun level_key opt_subtrie1 opt_subtrie2 ->
+                 let open Cd_Option in
+                 let subtrie1 = Option.default opt_subtrie1 self#empty
+                 and subtrie2 = Option.default opt_subtrie2 self#empty in
+                 let subtrie = subtrie1#merge_trie_inner
+                   merge_node [level_key :: kr] subtrie2 in
+                 if subtrie#is_empty
+                 then None
+                 else Some subtrie
+              )
+              l2
+        ;
+
+        method merge_trie_inner
+        : (list 'k -> list 'v -> list 'v -> list 'v)
+          -> list 'k
+          -> trie 'k 'v
+          -> trie 'k 'v
+        = fun merge_node kr t2 ->
+
+            let n1 = self#get_root_node
+            and n2 = t2#get_root_node in
+
+            new trie
+              (if n1 == [] && n2 == [] then [] else merge_node kr n1 n2)
+              (self#merge_levels merge_node kr self#get_level t2#get_level)
+        ;
+
+        method merge_trie
+        : (list 'k -> list 'v -> list 'v -> list 'v)
+          -> trie 'k 'v
+          -> trie 'k 'v
+        = fun merge_node t2 ->
+            self#merge_trie_inner merge_node [] t2
+        ;
+
         (* raises Not_found when level does not exist *)
         method get_down
         : !'a . list 'k ->
             self#fold_prefix f init []
         ;
 
-(*
-        method merge
-        : (list 'v -> list 'v -> list 'v) -> trie 'k 'v -> trie 'k 'v
-        = fun merge_nodes t ->
-          
-        ;
-*)
-
       end
     ;
 
 
     (* todo: другие мемоизации *)
 
+    (* todo: Timp.map_rw{s,m} over Hashtbl.Make() based on teqhash 'k *)
 
   end
 ;

File test/test.ml

 ;
 
 
+value trie_test_merge_flip ~flip ~expect =
+  let t1 = (trie_test_env ())#ex5
+      (* = [ "1/3/4 => 1;3;4" ; "1/3/4 => 1;3;4 very new" ] *) in
+  let t1 = t1#add [1;3] "1;3" in
+  let t2 = t1 in
+  let t1 = t1#add [2] "2" in
+  let t1 = t1#add [1] "1" in
+  let t2 = t2#replace [1;3] "t2:1;3" in
+  let t2 = t2#add [1] "t2:1" in
+  let t2 = t2#replace [1;3;4] "t2:1;3;4 very new" in
+  let s = List.sort String.compare in
+
+  (* here:
+     t1 = [ "1 => 1" ; "1/3 => 1;3" ; "1/3/4 => 1;3;4"
+          ; "1/3/4 => 1;3;4 very new" ; "2 => 2" ]
+     t2 = ["1 => t2:1" ; "1/3 => t2:1;3" ; "1/3/4 => 1;3;4"
+          ; "1/3/4 => t2:1;3;4 very new" ]
+   *)
+
+  let (t1, t2) =
+    match flip with
+    [ False -> (t1, t2)
+    | True -> (t2, t1)
+    ]
+  in
+
+  assert_equal ~printer:printer_list_string
+
+    ( s expect
+    )
+
+    ( s &
+      string_of_int_string_trie &
+      t1#merge_trie
+       (fun rev_key_path n1 n2 ->
+          let key_string =
+            rev_key_path
+            |> List.rev
+            |> List.map string_of_int
+            |> String.concat "/"
+          in
+          let nstring n : string =
+            n
+            |> List.map (sprintf "{%s}")
+            |> String.concat " + "
+            |> sprintf "[%s]"
+          in
+          [ sprintf "%s => %s + %s" key_string (nstring n1) (nstring n2) ]
+       )
+       t2
+    )
+;
+
+
+
+value trie_merge_tests =
+  let open List.Monad in
+  [ ( False
+    , [ "1 => 1 => [{1}] + [{t2:1}]"
+      ; "1/3 => 1/3 => [{1;3}] + [{t2:1;3}]"
+      ; "1/3/4 => 1/3/4 => [{1;3;4 very new} + {1;3;4}] \
+                + [{t2:1;3;4 very new} + {1;3;4}]"
+      ; "2 => 2 => [{2}] + []"
+      ]
+    )
+  ; ( True
+    , [ "1 => 1 => [{t2:1}] + [{1}]"
+      ; "1/3 => 1/3 => [{t2:1;3}] + [{1;3}]"
+      ; "1/3/4 => 1/3/4 => [{t2:1;3;4 very new} + {1;3;4}] \
+                + [{1;3;4 very new} + {1;3;4}]"
+      ; "2 => 2 => [] + [{2}]"
+      ]
+    )
+  ] >>= fun (flip, expect) ->
+  [ (sprintf "merge_trie %s"
+      (if flip then "->" else "<-")
+    )
+    >::
+    (fun () -> 
+       trie_test_merge_flip ~flip ~expect
+    )
+  ]
+;
+
+
 value utf8eqtest () =
   assert_equal
     Strings.Utf8.(
   ; "trie_test6" >:: trie_test6
   ; "trie_test7" >:: trie_test7
   ]
+  @ trie_merge_tests
 ;