more tests, there is an error in the algorithm, that requires a significant refactoring.

dune-project

-(lang dune 3.0)
+(lang dune 3.7)
 
 (name robinson)
 

lib/pqtrees/pqChainInsertion.ml

@@ -47,7 +47,8 @@ module Make =
 
     type external_subtree = 
       | ConstantSubtree of int * pqtree 
-      | IncreasingSubtree of int * pqtree DeQueue.t * int (* an increasing subtree is necessarily a Q-node *)
+      | IncreasingSubtree of int * pqtree DeQueue.t * int 
+      (* an increasing subtree is necessarily a Q-node *)
 
     let bounds = function 
     | ConstantSubtree (delta,_) -> (delta, delta)

lib/pqtrees/pqChainInsertion.mli

+open DataStruct
+
 module Make :
   functor (Chain : sig type t val s : t val d : t -> int end) ->
     sig
-    val insert_chain : Chain.t PqTree.t -> Chain.t PqTree.t option
-  end
+      type elt = Chain.t
+      type pqtree = elt PqTree.t 
+
+      val q_node : pqtree DeQueue.t -> pqtree
+
+
+      type external_subtree = 
+      | ConstantSubtree of int * pqtree 
+      | IncreasingSubtree of int * pqtree DeQueue.t * int 
+
+      val bounds : external_subtree -> int * int 
+      val d_min : external_subtree -> int 
+      val d_max : external_subtree -> int 
+      val tree_of_external_tree : external_subtree -> pqtree 
+      val is_increasing_sequence : external_subtree DeQueue.t -> bool 
+      val force_increasing_sequence : external_subtree DeQueue.t -> external_subtree DeQueue.t option
+      val expand_increasing_sequence : external_subtree DeQueue.t -> pqtree DeQueue.t 
+      val sort_into_increasing_sequence : external_subtree DeQueue.t -> external_subtree list DeQueue.t 
+
+      type sorting_group = 
+      | Group of int * pqtree list 
+      | Single of external_subtree
+ 
+      val group_d_min : sorting_group -> int 
+      val group_d_max : sorting_group -> int 
+      val sort_children_of_p_node : external_subtree DeQueue.t -> sorting_group DeQueue.t 
+
+      val is_increasing_group_sequence : sorting_group DeQueue.t -> bool
+
+
+      type centered_subtree =
+      | Balanced of int * pqtree
+      | Skew of int * pqtree DeQueue.t * int 
 
+      val tree_of_centered_tree : centered_subtree -> pqtree
+      val bounds_centered : centered_subtree -> int * int 
+      val contract_centered : centered_subtree -> pqtree list 
+
+      type result = 
+      | NotRepresentable
+      | CenteredSubtree of centered_subtree
+      | ExternalSubtree of external_subtree 
+
+      type classification =
+      | Unclassifiable
+      | Internal of external_subtree DeQueue.t * centered_subtree * external_subtree DeQueue.t 
+      | External of external_subtree DeQueue.t 
+
+      val classify : result list -> classification
+
+
+      type queue = 
+        { left_bound : int;
+          trees : pqtree DeQueue.t;
+          right_bound : int
+        }
+
+      val init_queue : centered_subtree -> queue
+      val is_balanced : queue -> bool 
+      val collapse : queue -> int * pqtree
+      val enqueue_right : sorting_group -> queue -> queue
+      val enqueue_left : sorting_group -> queue -> queue
+      val finalize : queue -> centered_subtree
+      val enqueue : sorting_group DeQueue.t -> queue -> result
+
+      val build_p_internal : centered_subtree -> external_subtree DeQueue.t -> result
+
+      val centered_subtree : int -> pqtree DeQueue.t -> int -> result 
+
+      val build_q_internal : external_subtree DeQueue.t -> centered_subtree -> external_subtree DeQueue.t -> result
+      val contract_group : sorting_group -> pqtree DeQueue.t 
+      val build_p_external : external_subtree DeQueue.t -> result
+      val build_q_external : external_subtree DeQueue.t -> result 
+      val dispatch : pqtree -> result list -> result 
+      val children : pqtree -> pqtree list
+      val solve : pqtree -> result
+      val insert_chain : pqtree -> pqtree option
+    end
 val refine_by_distances : 'elt -> ('elt -> int) -> 'elt PqTree.t -> 'elt PqTree.t option

lib/pqtrees/pqTree.mli

@@ -165,7 +165,7 @@ end
 
 (** A functor to build a function to enumerate over PQ-trees. *)
 module MakeEnumerate : 
-  functor (RND : FeatCore.RandomSig.S) -> EnumerateSig with type elt = int 
+  functor (_ : FeatCore.RandomSig.S) -> EnumerateSig with type elt = int 
 
 
 (** A pre-application of the [MakeEnumerate] functor, to enumerate of

robinson.opam

@@ -11,7 +11,7 @@ doc: "https://url/to/documentation"
 bug-reports: "https://github.com/username/reponame/issues"
 depends: [
   "ocaml"
-  "dune" {>= "3.0"}
+  "dune" {>= "3.7"}
   "fix"
   "feat"
   "RobinsonLib"

test/propertytest/chainInsertion.ml

+open PqTreeLib
+open RobinsonTest 
+open IntPqTree
+open DataStruct
+
+open QCheck2 
+
+
+module IntSet = Set.Make(Int) 
+
+let insert_interval interval pqtree = 
+  let f i = if IntSet.mem i interval then 0 else 1 in 
+  let s = IntSet.choose interval in
+  PqChainInsertion.refine_by_distances s f pqtree 
+
+
+let rec is_an_interval ints = function 
+  | [] -> IntSet.cardinal ints = 0
+  | (hd :: _) as permutation when IntSet.mem hd ints -> 
+     let length = IntSet.cardinal ints in 
+     (permutation |> MoreList.take length |> List.for_all (fun i -> IntSet.mem i ints))
+     && (permutation |> MoreList.drop length |> List.for_all (fun i -> not (IntSet.mem i ints)))
+  | _ :: permutation -> is_an_interval ints permutation
+
+
+let interval_insertion_does_not_fail (pqtree,interval) =
+  insert_interval (IntSet.of_list interval) pqtree 
+  |> Option.is_some 
+
+
+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))
+    Gen.(int_range 1 100 >>= sized_pqtree_interval_gen)
+    interval_insertion_does_not_fail
+    
+
+
+let tests = 
+  [ 
+    test_interval_insertion_does_not_fail
+  ]

test/propertytest/main_prop_test.ml

@@ -3,7 +3,8 @@ let all_tests =
     [ Pqtree.tests;
       FunctionalBLtest.tests; 
       ImperativeBLTest.tests;
-      Pivotpair.tests
+      Pivotpair.tests;
+      ChainInsertion.tests
     ]
 
 let%test _ =

test/unit/chainInsertionTest.ml

@@ -96,30 +96,63 @@ let%expect_test _ =
 
 let d3 = [|66;5;56;0;15;77;3;82;56;60|]
 let d4 = [|52;12;41;15;0;63;18;67;42;46|]
-let d5 = [|12;74;22;77;63;0;80;7;23;18|]
-let d6 = [|69;8;59;3;18;80;0;84;59;63|]
-let d7 = [|16;78;27;82;67;7;84;0;27;23|]
-let d8 = [|11;52;8;56;42;23;59;27;0;10|]
-let d9 = [|9;57;5;60;46;18;63;23;10;0|]
 
 let%expect_test _ = 
   refine_by_distances 3 (fun n -> d3.(n)) tree_2
   |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
 let%expect_test _ = 
   refine_by_distances 4 (fun n -> d4.(n)) tree_2
-  |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
+  |> output; [%expect{|not an interval|}]
+
+
+
+let interval_distance elements i = 
+  if List.mem i elements then 0
+  else 1
+
+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
+   ]
+
 let%expect_test _ = 
-  refine_by_distances 5 (fun n -> d5.(n)) tree_2
-  |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
+  refine_by_distances 10 (interval_distance [10;12]) ptree1 
+  |> output; [%expect{| |}]
+
+
+let ptree2 = 
+  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]]
+
 let%expect_test _ = 
-  refine_by_distances 6 (fun n -> d6.(n)) tree_2
-  |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
+  refine_by_distances 10 (interval_distance [10;12]) ptree2
+  |> output; [%expect{| |}]
+
+
+let ptree3 = 
+  P[Leaf 2;
+    P[Leaf 7;P[Leaf 9;Leaf 10]];
+    P[Leaf 12;Leaf 13]
+   ]
+
 let%expect_test _ = 
-  refine_by_distances 7 (fun n -> d7.(n)) tree_2
-  |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
+  refine_by_distances 10 (interval_distance [10;12]) ptree3
+  |> output; [%expect{| |}]
+
+let ptree4 = 
+    P[Leaf 7;P[Leaf 8; Leaf 9;Leaf 10];Leaf 11]
+
 let%expect_test _ = 
-  refine_by_distances 8 (fun n -> d8.(n)) tree_2
-  |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
+  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 9 (fun n -> d9.(n)) tree_2
-  |> output; [%expect{|Q[Leaf 6;Leaf 3;Leaf 1;Leaf 4;Leaf 8;Leaf 2;Leaf 9;Leaf 0;Leaf 5;Leaf 7]|}]
+  refine_by_distances 10 (interval_distance [10;12]) ptree5
+  |> output; [%expect{| |}]

test/unit/dune

 (library
   (name RobinsonUnit)
-  (libraries RobinsonLib RobinsonTest)
+  (libraries RobinsonLib ChainLib RobinsonTest)
   (inline_tests)
   (preprocess (pps ppx_inline_test ppx_expect))
 ) 

test/unit/robinsonByChainTest.ml

+open RobinsonTest.IntPqTree
+
+open ChainLib
+
+
+let output result = 
+  result
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline
+
+
+let print_order order = 
+  let open Format in 
+  fprintf std_formatter
+    "%a\n" 
+    (pp_print_list ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") pp_print_int)
+    order
+
+
+let diss1 = RandomDissimilarity.Toeplitz.toeplitz012 ~k:1 ~n:10 
+
+let%expect_test _ = 
+  begin match RobinsonByChain.find_compatible_order diss1 with 
+  | Some order -> print_order order 
+  | None -> Format.(fprintf std_formatter "not Robinson")
+  end;
+  [%expect{| 9, 8, 7, 6, 5, 4, 3, 2, 1, 0 |}]
+  
+
+let diss2 = RandomDissimilarity.Toeplitz.toeplitz012 ~k:3 ~n:20
+
+let%expect_test _ = 
+  begin match RobinsonByChain.find_compatible_order diss2 with 
+  | 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 |}]