diff --git a/lib/pqtrees/pqChainInsertion.ml b/lib/pqtrees/pqChainInsertion.ml index 498e1d1c8d4928c0a34a61b20550ac57420bd3a9..efbd4376862815b283038e544cf5eb017a332847 100644 --- a/lib/pqtrees/pqChainInsertion.ml +++ b/lib/pqtrees/pqChainInsertion.ml @@ -68,6 +68,7 @@ module Make = let q_node subtrees = match DeQueue.to_list subtrees with + | [single] -> single | [_1;_2] as children -> P children | children -> Q children @@ -201,7 +202,7 @@ module Make = | Some _ -> q_node subtrees | None -> assert false - let compact (Central (left_bound,_,right_bound) as tree) = + let consolidate (Central (left_bound,_,right_bound) as tree) = Central (left_bound, DeQueue.singleton (central_tree tree), right_bound) let reverse (Central (left_bound, subtrees, right_bound)) = @@ -232,8 +233,9 @@ module Make = let push bound_left bound_right central group = let d_min = group_d_min group and d_max = group_d_max group in let central = - if d_min >= max (left_bound_of central) (right_bound_of central) then - compact central + if d_min >= max (left_bound_of central) (right_bound_of central) + && Bound.is_bounded d_min bound_left && Bound.is_bounded d_min bound_right then + consolidate central else central in diff --git a/test/unit/chainInsertionTest.ml b/test/unit/chainInsertionTest.ml index 95fa15190f333a6bf71717d9627a0968f782b461..03deeead9c115f5705543bc3686c8b874e812cef 100644 --- a/test/unit/chainInsertionTest.ml +++ b/test/unit/chainInsertionTest.ml @@ -113,14 +113,24 @@ let interval_distance elements i = let ptree1 = P[Leaf 0;Leaf 1; P[Leaf 2;Leaf 3;Leaf 4; - P[P[P[Leaf 5;Leaf 6];Leaf 7];Leaf 8;P[Leaf 9;Leaf 10];Leaf 11]; - P[Leaf 12;Leaf 13]];Leaf 14;Leaf 15;Leaf 16;Leaf 17; - P[P[Leaf 18;Leaf 19];Leaf 20;Leaf 21];Leaf 22 + P[P[P[Leaf 5;Leaf 6];Leaf 7]; + Leaf 8; + P[Leaf 9;Leaf 10]; + Leaf 11]; + P[Leaf 12;Leaf 13]]; + Leaf 14;Leaf 15;Leaf 16;Leaf 17; + P[P[Leaf 18;Leaf 19];Leaf 20;Leaf 21]; + Leaf 22 ] let%expect_test _ = refine_by_distances 10 (interval_distance [10;12]) ptree1 - |> output; [%expect{| |}] + |> output; [%expect{| + P[Leaf 0;Leaf 1; + P[Leaf 2;Leaf 3;Leaf 4; + Q[P[P[P[Leaf 5;Leaf 6];Leaf 7];Leaf 8;Leaf 11];Leaf 9;Leaf 10; + Leaf 12;Leaf 13]];Leaf 14;Leaf 15;Leaf 16;Leaf 17; + P[P[Leaf 18;Leaf 19];Leaf 20;Leaf 21];Leaf 22] |}] let ptree2 = @@ -130,7 +140,10 @@ let ptree2 = let%expect_test _ = refine_by_distances 10 (interval_distance [10;12]) ptree2 - |> output; [%expect{| |}] + |> output; [%expect{| + P[Leaf 2;Leaf 3;Leaf 4; + Q[P[P[P[Leaf 5;Leaf 6];Leaf 7];Leaf 8;Leaf 11];Leaf 9;Leaf 10;Leaf 12; + Leaf 13]] |}] let ptree3 = @@ -141,18 +154,11 @@ let ptree3 = let%expect_test _ = refine_by_distances 10 (interval_distance [10;12]) ptree3 - |> output; [%expect{| |}] + |> output; [%expect{| P[Leaf 2;Q[Leaf 7;Leaf 9;Leaf 10;Leaf 12;Leaf 13]] |}] let ptree4 = P[Leaf 7;P[Leaf 8; Leaf 9;Leaf 10];Leaf 11] let%expect_test _ = - refine_by_distances 10 (interval_distance [10;12]) ptree4 - |> output; [%expect{| |}] - -let ptree5 = - P[Leaf 8; Leaf 9;Leaf 10] - -let%expect_test _ = - refine_by_distances 10 (interval_distance [10;12]) ptree5 - |> output; [%expect{| |}] + refine_by_distances 10 (interval_distance [8;10]) ptree4 + |> output; [%expect{| P[Leaf 7;P[P[Leaf 8;Leaf 10];Leaf 9];Leaf 11] |}] diff --git a/test/unit/robinsonByChainTest.ml b/test/unit/robinsonByChainTest.ml index a3ac4428b1fa5c3749d3c009ed916f6463709e35..364ab41d1f7e55159d02b50950589a848920e280 100644 --- a/test/unit/robinsonByChainTest.ml +++ b/test/unit/robinsonByChainTest.ml @@ -26,7 +26,7 @@ let%expect_test _ = | Some order -> print_order order | None -> Format.(fprintf std_formatter "not Robinson") end; - [%expect{| 9, 8, 7, 6, 5, 4, 3, 2, 1, 0 |}] + [%expect{| 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 |}] let diss2 = RandomDissimilarity.Toeplitz.toeplitz012 ~k:3 ~n:20 @@ -36,4 +36,4 @@ let%expect_test _ = | Some order -> print_order order | None -> Format.(fprintf std_formatter "not Robinson") end; - [%expect{| 19, 18, 17, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0 |}] + [%expect{| 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19 |}]