Commits

Yit Phang Khoo committed e19fb7f

Save one word from WeakSet, and add some tests.

Comments (0)

Files changed (5)

Source/AdaptonInternal/WeakSet.ml

     let limit = 8
 
     type t = {
-        mutable size : int;
         mutable extent : int;
         mutable array : H.t Weak.t;
     }
 
     type data = H.t
 
-    let create n = { size=0; extent=0; array=Weak.create (max 1 n) }
+    let is_array xs = Weak.length xs.array <= limit
 
-    let clear xs = if xs.size <= limit then xs.size <- 0 else xs.array <- Weak.create xs.size
+    let create n = { extent=0; array=Weak.create (max 1 n) }
+
+    let clear xs = if is_array xs then xs.extent <- 0 else xs.array <- Weak.create (Weak.length xs.array)
 
     let fold fn xs acc =
         let acc = ref acc in
-        if xs.size <= limit then begin
+        if is_array xs then begin
             (* as array, fold while compacting the array *)
             let j = ref 0 in
-            for i = 0 to xs.size - 1 do
+            for i = 0 to xs.extent - 1 do
                 match Weak.get xs.array i with
                     | Some x as x'opt ->
                         acc := fn x !acc;
                     | None ->
                         ()
             done;
-            xs.size <- !j;
+            xs.extent <- !j;
         end else
             (* as hash table, just fold *)
-            for i = 0 to xs.size - 1 do
+            for i = 0 to Weak.length xs.array - 1 do
                 match Weak.get xs.array i with
                     | Some x -> acc := fn x !acc;
                     | None -> ()
 
     let rec merge xs x =
         let resize () =
-            let old_size = xs.size in
+            let old_size = Weak.length xs.array in
             let old_array = xs.array in
+            xs.extent <- 0;
             xs.array <- Weak.create (old_size * 2);
-            if Weak.length xs.array <= limit then begin
+            if is_array xs then
                 (* as array, copy and compact *)
-                let j = ref 0 in
                 for i = 0 to old_size - 1 do
                     match Weak.get old_array i with
-                        | Some _ as x'opt -> Weak.set xs.array !j x'opt; incr j
-                        | None -> ()
-                done;
-                xs.size <- !j
-            end else begin
+                        | Some _ as x'opt ->
+                            Weak.set xs.array xs.extent x'opt;
+                            xs.extent <- xs.extent + 1
+                        | None ->
+                            ()
+                done
+            else
                 (* as hash table, reinsert *)
-                xs.size <- Weak.length xs.array;
                 for i = 0 to old_size - 1 do
                     match Weak.get old_array i with
                         | Some x -> ignore (merge xs x)
                         | None -> ()
                 done
-            end
         in
-        if xs.size <= limit then
+        if is_array xs then
             (* as array, use fold to find and compact *)
             let x'opt = fold begin fun x' x'opt -> match x'opt with
                 | Some _ -> x'opt
                 | Some x ->
                     x
                 | None ->
-                    if Weak.length xs.array <= xs.size then resize ();
-                    if xs.size < limit then begin
-                        Weak.set xs.array xs.size (Some x);
-                        xs.size <- xs.size + 1;
+                    if xs.extent >= Weak.length xs.array then resize ();
+                    if is_array xs then begin
+                        Weak.set xs.array xs.extent (Some x);
+                        xs.extent <- xs.extent + 1;
                         x
                     end else
                         merge xs x
         else
             (* as hash table, perform a lookup with linear probing *)
-            let i = H.hash x mod xs.size in
-            let window = max limit (xs.size / 4) in
+            let size = Weak.length xs.array in
+            let i = H.hash x mod size in
+            let window = max limit (size / 4) in
             let rec find j result =
                 if j <= xs.extent then
-                    let k = (i + j) mod xs.size in
+                    let k = (i + j) mod size in
                     match Weak.get xs.array k with
                         | Some x' when H.equal x x' -> x'
                         | Some _ -> find (j + 1) result
                     | None ->
                         let rec find j =
                             if j < window then
-                                let k = (i + j) mod xs.size in
+                                let k = (i + j) mod size in
                                 match Weak.get xs.array k with
                                     | Some _ -> find (j + 1)
                                     | None -> xs.extent <- max j xs.extent; Weak.set xs.array k (Some x); x

Test/TestAdaptonInternal.mlpack

+TestAdaptonInternal/TestWeakSet

Test/TestAdaptonInternal/TestWeakSet.ml

+open TestUtil.MyOUnit
+open Format
+
+
+let make_correctness_testsuite configs =
+    "Correctness" >::: List.map begin fun ( label, float_hash ) ->
+        label >:: QC.forall (QC.pair QC.int (QC.list (QC.list QC.float))) begin fun ( seed, xss ) ->
+            let module F = AdaptonInternal.WeakSet.Make (struct include AdaptonUtil.Types.Float let hash = float_hash seed end) in
+            let ys = Hashtbl.create 0 in
+            let zs = F.create 0 in
+            List.iter begin fun xs ->
+                List.iter begin fun x ->
+                    Hashtbl.replace ys x ();
+                    assert_equal ~printer:pp_print_float (F.merge zs x) x;
+                end xs;
+                let ws = F.fold (fun z ws -> z::ws) zs [] in
+                assert_mem ~printer:pp_print_float (fun y ys -> Hashtbl.mem ys y) ws ys;
+            end xss
+        end
+    end configs
+
+
+let testsuite = "TestWeakSet" >::: [
+    make_correctness_testsuite [
+        ( "uniform", Hashtbl.seeded_hash );
+        ( "limited", (fun seed x -> (Hashtbl.seeded_hash seed x) mod 2) );
+        ( "skewed", (fun seed x -> let h = Hashtbl.seeded_hash seed x in if h land 1 == 1 then Hashtbl.seeded_hash seed seed else h) );
+    ];
+]

Test/TestAdaptonInternal/_tags

+<*.cm*>: for-pack(TestAdaptonInternal)

Test/runtestadapton.ml

 
 let _ =
     run_test_tt_main begin "TestAdapton" >::: [
+        TestAdaptonInternal.TestWeakSet.testsuite;
         TestAdapton.TestLazySparseArray.testsuite;
         TestAdapton.TestA.testsuite;
         TestAdapton.TestAArrayMappedTrie.testsuite;