diff --git a/lib/randomdissimilarity/fromPqtree.ml b/lib/randomdissimilarity/fromPqtree.ml index 17fbab10a1d2a7468beabac608d7e00f70660605..139056a95b2f5c209586615b093d4e1219d06aa7 100644 --- a/lib/randomdissimilarity/fromPqtree.ml +++ b/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 () = diff --git a/test/propertytest/chainInsertion.ml b/test/propertytest/chainInsertion.ml index ea4dd55cfe8e3e08d812dde42d3e5e4e2fd74f06..90034d80fe296ccfaad9c59bc8354386f5cdbcc4 100644 --- a/test/propertytest/chainInsertion.ml +++ b/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 diff --git a/test/propertytest/pqtree.ml b/test/propertytest/pqtree.ml index 7f9c0a2b1d71ac68f1152a5a4270d080c78c73e1..3039d78053dfcf56fed5fee538f962d30e1f5b31 100644 --- a/test/propertytest/pqtree.ml +++ b/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 diff --git a/test/testlib/intPqTree.ml b/test/testlib/intPqTree.ml index 6472c0289873db658b3b49797ea0704f0eb7ce09..b46c17a83bdbcb64d6791e14eb4852e2f2aee80f 100644 --- a/test/testlib/intPqTree.ml +++ b/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) ]