debugging, no more known bugs, need more tests

lib/randomdissimilarity/fromPqtree.ml

@@ -59,7 +59,10 @@ let uniform n =
 
 
 let pqtree_from_intervals ~n ~k =
-  let pqtree = P (DataStruct.MoreList.range 0 (n-1) |> List.map (fun i -> Leaf i)) in 
+  let pqtree = 
+    if n = 1 then Leaf 0
+    else P (DataStruct.MoreList.range 0 (n-1) |> List.map (fun i -> Leaf i)) 
+  in 
   let index i = i in 
   let algo = ImperativeBL.get_algorithms pqtree index in
   let insert_interval () =

test/propertytest/chainInsertion.ml

@@ -32,6 +32,7 @@ let test_interval_insertion_does_not_fail =
   Test.make
     ~name:"Chain insertion generalizes interval insertion in PQ-tree"
     ~print:Print.(pair to_string (list int))
+    ~count:1000
     Gen.(int_range 1 100 >>= sized_pqtree_interval_gen)
     interval_insertion_does_not_fail
     

test/propertytest/pqtree.ml

@@ -7,6 +7,29 @@ open QCheck2
 
 let print = IntPqTree.to_string
 
+
+let rec arity_checks = function 
+| Leaf _ -> true
+| P children -> List.length children >= 2 && List.for_all arity_checks children 
+| Q children -> List.length children >= 3 && List.for_all arity_checks children
+
+let test_arities_of_sampled_pqtree_are_valid = 
+  QCheck2.Test.make
+    ~name:"In sampled pqtrees, P nodes have >= 2 children, Q nodes >= 3 children"
+    ~count:100
+    ~print
+    Gen.(int_range 1 100 >>= sized_pqtree_gen)
+    arity_checks
+
+
+let test_shrinked_pq_trees_have_valid_arities = 
+  QCheck2.Test.make 
+    ~name:"Shrinked pqtrees have valid degrees"
+    ~print
+    pqtree_gen 
+    (fun tree -> Seq.fold_left (&&) true (Seq.map arity_checks (shrink tree)))
+
+
 let frontier_is_a_contained_permutation pqtree =
   CheckPermutation.contains_permutation pqtree (frontier pqtree)
 
@@ -65,7 +88,9 @@ let test_shuffled_frontier_is_a_contained_permutation =
 
 
 let tests = 
-  [ test_frontier_is_a_contained_permutation;
+  [ test_arities_of_sampled_pqtree_are_valid;
+    test_shrinked_pq_trees_have_valid_arities;
+    test_frontier_is_a_contained_permutation;
     test_sampled_permutation_is_contained_in_pqtree;
     test_shuffled_is_equal_to_pqtree;
     test_shuffled_frontier_is_a_contained_permutation

test/testlib/intPqTree.ml

@@ -78,7 +78,6 @@ let sized_pqtree_gen size =
       make_primitive 
         ~gen:(sized_uniform_gen size)
         ~shrink:PqTree.shrink;
-        (* ~shrink:(fun _ -> Seq.empty); *)
       (int_range 1 10 >>= fun k -> sized_interval_insertion_gen k size)
     ]