Initial commit

test/profiling/permutation_checker.ml

+let out_channel = open_out "prof.json"
+
+let () = 
+  let open Landmark in 
+  let options = Landmark.profiling_options ()  in 
+  Landmark.set_profiling_options
+    { options with 
+      format = JSON;
+      output = Channel out_channel 
+    }
+
+open PqTreeLib
+
+module IntMap = Map.Make(Int)
+module Checker = PqTree.MakeCheckPermutation(IntMap)
+
+let () = 
+  let pqtree = PqTree.sample 60 in 
+  let checker = Checker.checker pqtree in
+  for _i = 0 to 99 do 
+    let permutation = PqTree.sample_permutation pqtree in 
+    let[@landmark] res = Checker.checks checker permutation in
+    if not (res) then 
+      begin 
+        Format.fprintf Format.err_formatter "error in permutation checker";
+        exit 1;
+      end 
+  done

test/propertytest/dune

+(library
+ (name main_prop_test)
+ (libraries PqTreeLib RobinsonLib Recognition qcheck RobinsonTest)
+ (inline_tests)
+ (preprocess (pps ppx_inline_test))
+)
+

test/propertytest/functionalBLtest.ml

+open PqTreeLib
+open DataStruct
+open RobinsonTest
+open IntPqTree 
+
+open QCheck2
+
+
+module IntSet = Set.Make(Int) 
+
+
+let insert ints pqtree = 
+  FunctionalBL.add_interval 
+    (fun i -> IntSet.mem i ints) 
+    (IntSet.cardinal ints) 
+    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 (IntSet.of_list interval) pqtree 
+  |> Option.is_some
+
+let test_interval_insertion_does_not_fail =
+  Test.make 
+    ~name:"An interval of a PQ-tree may be inserted in that PQ-tree"
+    ~print:Print.(pair to_string (list int))
+    Gen.(int_range 1 100 >>= sized_pqtree_interval_gen)
+    interval_insertion_does_not_fail
+
+
+let inserted_interval_is_interval_of_sampled_permutation (pqtree, interval) =
+  let interval = IntSet.of_list interval in
+  match insert interval pqtree with 
+  | None -> true
+  | Some pqtree -> 
+     MoreList.range 0 99 
+     |> List.for_all (fun _ ->  
+            let permutation = PqTree.sample_permutation pqtree in 
+            is_an_interval interval permutation 
+          )
+
+let test_inserted_interval_is_interval_of_sampled_permutation =
+  Test.make 
+    ~name:"An interval inserted in a PQ-tree is always an interval of any sampled permutation"
+    ~print:Print.(pair to_string (list int))
+    Gen.(int_range 1 100 >>= sized_pqtree_interval_gen)
+    inserted_interval_is_interval_of_sampled_permutation
+
+
+let insert_is_idempotent (pqtree,interval) =
+  let interval = IntSet.of_list interval in 
+  let pqtree' = insert interval pqtree in 
+  let pqtree'' = Option.bind pqtree' (insert interval) in 
+  Option.compare IntPqTree.Canonical.compare pqtree' pqtree'' = 0
+
+let test_insert_is_idempotent = 
+  Test.make 
+  ~name:"insert is idempotent" 
+  ~print:Print.(pair to_string (list int)) 
+  Gen.(int_range 1 100 >>= sized_pqtree_interval_gen)
+  insert_is_idempotent 
+
+let tests = 
+  [ 
+    test_interval_insertion_does_not_fail;
+    test_inserted_interval_is_interval_of_sampled_permutation;
+    test_insert_is_idempotent;
+  ]

test/propertytest/imperativeBLTest.ml

+open PqTreeLib
+open RobinsonTest
+open IntPqTree
+open QCheck2 
+
+let make_algorithms pqtree =
+  ImperativeBL.get_algorithms pqtree (fun i -> i)
+
+let fun_insert interval pqtree =
+  FunctionalBL.add_interval
+    (fun i -> List.mem i interval) 
+    (List.length interval) 
+    pqtree 
+
+let pqtree_to_impBLstruct_to_pqtree_is_identity pqtree =
+  let algos = make_algorithms pqtree in 
+  let pqtree' = algos.get () in 
+  Canonical.compare pqtree pqtree' = 0
+
+
+let test_pqtree_to_impBLstruct_to_pqtree_is_identity =
+  Test.make 
+    ~name:"PQ-tree to imperative BL struct to PQ-tree is identity"
+    ~print:to_string 
+    Gen.(int_range 2 100 >>= sized_pqtree_gen)
+    pqtree_to_impBLstruct_to_pqtree_is_identity
+
+
+
+let intervals_are_correctly_checked (pqtree, interval) =
+  let algos = make_algorithms pqtree in 
+  algos.is_interval interval 
+
+let test_interval_are_correctly_checked =
+  Test.make 
+  ~name:"Intervals are correctly checked by Imperative BL"
+  ~print:Print.(pair to_string (list int)) 
+  Gen.(int_range 2 100 >>= sized_pqtree_interval_gen)
+  intervals_are_correctly_checked
+  
+
+
+let inserted_interval_is_interval_in_resulting_pqtree (pqtree, interval, expected) =
+  let algos = make_algorithms pqtree in 
+  let is_success = algos.insert interval in 
+  is_success 
+  && Canonical.compare (algos.get ()) expected = 0
+  
+
+
+let test_inserted_interval_is_interval_in_resulting_pqtree = 
+  Test.make 
+    ~name:"An inserted interval is an interval in the resulting PQ-tree"
+    ~count:1000
+    ~print:Print.(triple to_string (list int) to_string)
+    Gen.(int_range 2 100 >>= fun i->
+         sized_pqtree_interval_gen i >>= fun (pqtree,interval) -> 
+         return (pqtree, interval, Option.get (fun_insert interval pqtree))
+    )
+    inserted_interval_is_interval_in_resulting_pqtree
+
+
+let resulting_tree_is_well_formed (pqtree, intervals) =
+  let algos = make_algorithms pqtree in 
+  let is_success = List.for_all algos.insert intervals in 
+  is_success && (PqTree.is_well_formed (algos.get ()))
+
+
+let test_resulting_tree_is_well_formed = 
+  Test.make 
+    ~name:"Tree resulting from inserting an interval is well-formed"
+    ~count:1000
+    ~print:Print.(pair to_string (list (list int))) 
+    Gen.(
+    int_range 1 10 >>= fun k ->
+    int_range 2 100 >>= fun n -> 
+    block_list_gen k n
+  )
+    resulting_tree_is_well_formed
+
+let tests = 
+  [ 
+    test_pqtree_to_impBLstruct_to_pqtree_is_identity;
+    test_interval_are_correctly_checked;
+    test_inserted_interval_is_interval_in_resulting_pqtree;
+    test_resulting_tree_is_well_formed;
+  ]
+    

test/propertytest/main_prop_test.ml

+let all_tests = 
+  List.flatten 
+    [ Pqtree.tests;
+      FunctionalBLtest.tests; 
+      ImperativeBLTest.tests;
+      Pivotpair.tests
+    ]
+
+let%test _ =
+  let errcode = 
+    QCheck_base_runner.run_tests 
+      ~verbose:true 
+      all_tests 
+  in
+  errcode = 0

test/propertytest/pivotpair.ml

+open Recognition 
+open DissimilarityLib.Dissimilarity
+open QCheck2 
+open RobinsonTest 
+
+let rev_index { elements; _ } elt =
+  let indexed = 
+    elements 
+    |> List.mapi (fun j e -> (e,j)) 
+  in 
+  List.assoc elt indexed
+
+let pivotpair_algorithm_terminates diss = 
+  match Pivotpair.algo diss (rev_index diss) with 
+  | Some order ->
+     DissimilarityLib.Dissimilarity.is_compatible_order diss order 
+  | None -> true
+   
+
+let test_pivotpair_algorithm_terminates =
+  Test.make 
+    ~name:"Algorithm pivotpair terminates without error"
+    ~count:1000
+    ~print:IntDissimilarity.to_string
+    (IntDissimilarity.from_rectangles ~width:100. ~height:10. 10)
+    (* Gen.(
+     *   int_range 1 20 >>= fun k -> 
+     *   int_range 2 100 >>= fun n -> 
+     *   IntDissimilarity.from_intervals ~k n >>= fun diss -> 
+     *   return diss
+     * ) *)
+  pivotpair_algorithm_terminates
+
+
+
+
+
+
+let blocks_discriminates_triplets diss =
+  let d = diss.d in 
+  (d 0 2 < max (d 0 1) (d 1 2))
+  || ( match Pivotpair.find_blocks diss 0 2 with 
+       | Some blocks -> 
+          List.exists (fun b -> List.mem 0 b && List.mem 2 b && not (List.mem 1 b)) blocks
+       | None -> true
+     )
+
+let test_blocks_discriminates_triplets = 
+  Test.make
+    ~name:"Blocks used by pivoting discriminates invalid triplets"
+    ~count:1000
+    ~print:IntDissimilarity.to_string 
+    (IntDissimilarity.from_rectangles ~width:100. ~height:10. 20)
+    blocks_discriminates_triplets
+
+let tests = 
+  [
+    test_pivotpair_algorithm_terminates;
+    test_blocks_discriminates_triplets;
+  ]

test/propertytest/pqtree.ml

+open PqTreeLib
+open RobinsonTest
+open PqTree
+open IntPqTree 
+
+open QCheck2
+
+let print = IntPqTree.to_string
+
+let frontier_is_a_contained_permutation pqtree =
+  CheckPermutation.contains_permutation pqtree (frontier pqtree)
+
+let test_frontier_is_a_contained_permutation = 
+  QCheck2.Test.make
+    ~name:"The frontier of a PQ-tree is a contained in that PQ-tree"
+    ~print 
+    pqtree_gen 
+    frontier_is_a_contained_permutation 
+
+
+
+
+let sized_pq_tree_permutation_gen size = 
+  let open Gen in 
+  sized_pqtree_gen size >>= fun pqtree -> 
+  permutation_gen pqtree >>= fun permutation ->
+  return (pqtree, permutation)
+  
+
+let sampled_permutation_is_contained_in_pqtree (pqtree, permutation) = 
+  CheckPermutation.contains_permutation pqtree permutation 
+
+let test_sampled_permutation_is_contained_in_pqtree = 
+  QCheck2.Test.make 
+    ~name:"A sampled permutation from a PQ-tree is contained in that PQ-tree"
+    ~print:QCheck2.Print.(pair print (list int))
+    Gen.(int_range 1 100 >>= sized_pq_tree_permutation_gen) 
+    sampled_permutation_is_contained_in_pqtree
+
+
+
+let shuffled_is_equal_to_pqtree (tpeqre, pqtree) =
+  Canonical.compare tpeqre pqtree = 0 
+
+let test_shuffled_is_equal_to_pqtree =
+  QCheck2.Test.make 
+    ~name:"a PQ-tree and its shuffle must be equal"
+    ~print:QCheck2.Print.(pair print print) 
+    Gen.(int_range 1 100 >>= sized_shuffled_pair_gen)
+  shuffled_is_equal_to_pqtree
+  
+
+
+let shuffled_frontier_is_a_contained_permutation (tpeqre,pqtree) =
+  CheckPermutation.contains_permutation pqtree (frontier tpeqre) 
+
+let test_shuffled_frontier_is_a_contained_permutation = 
+  QCheck2.Test.make 
+    ~name:"The frontier of a shuffled PQ-tree must be a valid permutation"
+    ~print:QCheck2.Print.(pair print print)
+    Gen.(int_range 1 100 >>= sized_shuffled_pair_gen)
+    shuffled_frontier_is_a_contained_permutation
+
+
+
+
+let tests = 
+  [ 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/propertytest/pqtree.mli

+val tests : QCheck2.Test.t list 

test/testlib/dune

+(library
+ (name RobinsonTest) 
+ (libraries RobinsonLib PqTreeLib RandomDissimilarity feat fix qcheck)
+ (instrumentation (backend landmarks))
+)

test/testlib/intDissimilarity.ml

+open! DataStruct 
+open DissimilarityLib
+open Dissimilarity
+
+open QCheck2 
+
+
+let shrink { elements; d } = 
+  if List.length elements <= 1 then Seq.empty 
+  else
+    elements 
+    |> MoreList.extend 
+    |> List.to_seq
+    |> Seq.map (fun (_,pre,post) -> { elements = List.rev_append pre post; d })
+
+
+
+
+let primitive_gen sampler size = 
+  Gen.make_primitive
+    ~gen:(fun state -> 
+      Random.set_state state;
+      sampler size
+    )
+    ~shrink 
+
+
+let toeplitz ~k n = 
+  primitive_gen 
+    (fun size -> RandomDissimilarity.Toeplitz.toeplitz012 ~n:size ~k)
+    n
+
+
+let uniform n = 
+  primitive_gen 
+    RandomDissimilarity.FromPqtree.uniform
+    n 
+
+
+let from_intervals ~k n = 
+  primitive_gen 
+    (fun size -> RandomDissimilarity.FromPqtree.from_intervals ~n:size ~k)
+    n 
+
+let from_rectangles ~width ~height n =
+  primitive_gen 
+    (fun size -> RandomDissimilarity.FromModel.from_points_in_rectangle ~width ~height ~count:size)
+    n 
+
+let to_string diss = 
+  Format.fprintf Format.str_formatter "%a\n" IO.Plain.pretty_printer diss;
+  Format.flush_str_formatter ()
+
+

test/testlib/intDissimilarity.mli

+open DissimilarityLib
+open QCheck2
+
+val shrink : 'elt Dissimilarity.t -> 'elt Dissimilarity.t Seq.t
+
+val primitive_gen : (int -> 'elt Dissimilarity.t) -> int -> 'elt Dissimilarity.t Gen.t
+
+
+val toeplitz : k:int -> int -> int Dissimilarity.t Gen.t 
+
+val uniform : int -> int Dissimilarity.t Gen.t 
+
+val from_intervals : k:int -> int -> int Dissimilarity.t Gen.t 
+
+val from_rectangles : width:float -> height:float -> int -> int Dissimilarity.t Gen.t
+
+val to_string : 'elt Dissimilarity.t -> string 

test/testlib/intPqTree.ml

+open PqTreeLib
+open QCheck2 
+open PqTree 
+
+
+module PrintableInt = 
+  struct 
+    type t = int 
+    let print fmt i = Format.fprintf fmt "%d" i 
+  end
+
+module Print = PqTree.MakePrinter(PrintableInt) 
+
+let to_string tree = 
+  Format.fprintf Format.str_formatter  "%a" Print.print tree;
+  Format.flush_str_formatter ()
+
+module Rnd : FeatCore.RandomSig.S = 
+  struct 
+    let bits () = Random.bits ()
+    let int bound = Random.int bound
+  end
+module Enum = PqTree.MakeEnumerate(Rnd)
+
+let sized_uniform_gen size random_state = 
+  Random.set_state random_state;
+  match Enum.sample 1 Enum.enumeration size (size+1) Seq.empty () with
+  | Seq.Cons (hd,_) -> hd 
+  | _ -> invalid_arg "PQ-tree sized gen called with invalid size"
+
+
+
+let pqtree_from_intervals ~n ~k =
+  let pqtree = 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 _ =
+    let interval = algo.get () |> PqTree.sample_interval in 
+    algo.insert interval |> ignore;
+    interval
+  in 
+  DataStruct.MoreList.range 1 k 
+  |> List.map insert_interval 
+  |> fun intervals -> (pqtree, intervals)
+
+let param_sized_block_list_gen k n random_state = 
+  Random.set_state random_state;
+  pqtree_from_intervals ~n ~k 
+
+
+let block_list_gen k size =
+  let open Gen in 
+  make_primitive 
+    ~gen:(param_sized_block_list_gen k size) 
+    ~shrink:(function 
+      | (_,[]) -> Seq.empty
+      | (pqtree,blocks) -> Seq.cons (pqtree, List.(blocks |> rev |> tl |> rev)) Seq.empty
+    )
+
+              
+
+let param_sized_interval_insertion_gen k n random_state = 
+  Random.set_state random_state;
+  RandomDissimilarity.FromPqtree.pqtree_from_intervals ~n ~k 
+  
+let sized_interval_insertion_gen k size =
+  let open Gen in 
+  make_primitive 
+    ~gen:(param_sized_interval_insertion_gen k size)
+    ~shrink:PqTree.shrink 
+
+
+
+let sized_pqtree_gen size =
+  let open Gen in 
+  oneof 
+    [
+      make_primitive 
+        ~gen:(sized_uniform_gen size)
+        ~shrink:PqTree.shrink;
+      (int_range 1 10 >>= fun k -> sized_interval_insertion_gen k size)
+    ]
+  
+
+let pqtree_gen = 
+  let open Gen in 
+  int_range 1 100 >>= sized_pqtree_gen
+
+
+
+let permutation_gen pqtree = 
+  let gen random_state = 
+    Random.set_state random_state;
+    PqTree.sample_permutation pqtree 
+  in 
+  Gen.make_primitive ~gen ~shrink:(fun _ -> Seq.empty)
+
+
+let interval_gen pqtree = 
+  let gen random_state = 
+    Random.set_state random_state;
+    PqTree.sample_interval pqtree 
+  in 
+  let shrink = function 
+    | [] -> Seq.empty
+    | [_] -> Seq.empty
+    | interval -> List.to_seq [ List.tl interval; List.tl (List.rev interval) ]  
+  in 
+  Gen.make_primitive ~gen ~shrink 
+
+
+let sized_pqtree_interval_gen size =
+  let open Gen in 
+  sized_pqtree_gen size >>= fun pqtree -> 
+  interval_gen pqtree >>= fun interval -> 
+  return (pqtree, interval)
+
+
+let shuffle_gen pqtree = 
+  let gen random_state = 
+    Random.set_state random_state;
+    PqTree.shuffle pqtree
+  in 
+  Gen.make_primitive ~gen ~shrink:(fun _ -> Seq.empty)
+
+
+let sized_shuffled_pair_gen size =
+  let open Gen in 
+  sized_pqtree_gen size >>= fun pqtree ->
+  shuffle_gen pqtree >>= fun shuffle -> 
+  return (shuffle, pqtree)
+
+
+module IntMap = Map.Make(Int)
+module CheckPermutation = PqTree.MakeCheckPermutation(IntMap)
+  
+
+module Canonical = MakeCanonical(Int) 
+

test/testlib/intPqTree.mli

+open PqTreeLib
+open QCheck2
+
+
+module Print : 
+sig 
+  val print : Format.formatter -> int PqTree.t -> unit 
+end 
+
+val to_string : int PqTree.t -> string 
+
+
+module Enum : 
+sig 
+  include FeatCore.EnumSig.ENUM
+  val enumeration : int PqTree.t enum
+end
+
+
+module IntMap : Map.S with type key = int 
+
+module CheckPermutation : PqTree.CheckPermutationSig with type elt = int 
+
+module Canonical : PqTree.CanonicalSig with type elt = int 
+
+
+val sized_pqtree_gen : int -> int PqTree.t Gen.t 
+
+val pqtree_gen : int PqTree.t Gen.t 
+
+val block_list_gen : int -> int -> (int PqTree.t * int list list) Gen.t
+
+
+val permutation_gen : 'elt PqTree.t -> 'elt list Gen.t 
+
+val interval_gen : 'elt PqTree.t -> 'elt list Gen.t 
+
+
+
+val sized_pqtree_interval_gen : int -> (int PqTree.t * int list) Gen.t 
+
+
+val sized_shuffled_pair_gen : int -> (int PqTree.t * int PqTree.t) Gen.t 
+

test/unit/dune

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

test/unit/functionalBLtest.ml

+
+open PqTreeLib
+open RobinsonTest 
+
+open IntPqTree 
+
+let is_in interval i = List.mem i interval 
+
+let insert interval tree = 
+  FunctionalBL.add_interval (is_in interval) (List.length interval) tree
+
+let test_naive (tree, interval, expected) = 
+  Option.compare Canonical.compare 
+    (insert interval tree)
+    expected 
+  = 0
+
+let%test _ = test_naive
+  ( P [Q [Leaf 1; Leaf 2; Leaf 3]; Leaf 4; Leaf 5],
+    [3;4],
+    Some (P [Q [Leaf 1; Leaf 2; Leaf 3; Leaf 4]; Leaf 5])
+  )
+
+
+let%test _ = test_naive
+  ( P [Leaf 1; Leaf 2; Leaf 3; Leaf 4; Leaf 5],
+    [1;3;5],
+    Some (P [P [Leaf 1; Leaf 3; Leaf 5]; Leaf 2; Leaf 4])
+  )
+
+
+let%test _ = test_naive
+  ( P [ Leaf 1; P [ Leaf 2; Leaf 3; Leaf 4; Leaf 5]],
+    [1;2;5],
+    Some (Q [P [Leaf 3; Leaf 4]; P [Leaf 2; Leaf 5]; Leaf 1])
+  )
+
+
+let%test _ = test_naive
+  (P [ Leaf 1; Q [Leaf 2; Leaf 3]; Leaf 4; Q [Leaf 5; Leaf 6]; Leaf 7],
+   [2;4;6],
+   Some (P [Q [Leaf 3; Leaf 2; Leaf 4; Leaf 6; Leaf 5]; Leaf 1; Leaf 7])
+  )
+
+
+let%expect_test _ = 
+  insert [2;4;6] (Q [ Leaf 1; Q [Leaf 2; Leaf 3]; Leaf 4; Q [Leaf 5; Leaf 6]; Leaf 7])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{|Q[Leaf 1;Leaf 3;Leaf 2;Leaf 4;Leaf 6;Leaf 5;Leaf 7]|}]
+
+
+let%expect_test _ = 
+  insert [2;3;7] (P [ Leaf 1; Q [Leaf 2; Leaf 3]; Leaf 4; Q [Leaf 5; Leaf 6]; Leaf 7])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{|P[Leaf 1;P[Q[Leaf 2;Leaf 3];Leaf 7];Leaf 4;Q[Leaf 5;Leaf 6]]|}]
+
+let%expect_test _ = 
+  insert [1;2;3;4;6] (Q [ Leaf 1; Q [Leaf 2; Leaf 3]; Leaf 4; Q [Leaf 5; Leaf 6]; Leaf 7])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{|Q[Leaf 1;Q[Leaf 2;Leaf 3];Leaf 4;Leaf 6;Leaf 5;Leaf 7]|}]
+
+let%expect_test _ = 
+  insert [2;4] (Q [ Leaf 1; P [Leaf 2; Leaf 3; Leaf 4; Leaf 5]; Leaf 6; Q [Leaf 7; Leaf 8]; Leaf 9])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{|Q[Leaf 1;P[P[Leaf 2;Leaf 4];Leaf 3;Leaf 5];Leaf 6;Q[Leaf 7;Leaf 8];Leaf 9]|}]
+
+
+let%expect_test _ = 
+  insert [2;4] (Q [ Leaf 1; Q [Leaf 2; Leaf 3; Leaf 4; Leaf 5]; Leaf 6; Q [Leaf 7; Leaf 8]; Leaf 9])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{|not an interval|}]
+
+
+let%expect_test _ = 
+  insert [1;5] (P [P [Leaf 1;Leaf 2]; P [Leaf 3;Leaf 4;Leaf 5]])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{| Q[Leaf 2;Leaf 1;Leaf 5;P[Leaf 3;Leaf 4]] |}]
+
+
+let%expect_test _ = 
+  insert [5;6;8] (Q [Leaf 2; Leaf 1; Q [Leaf 3; Leaf 4; Leaf 5; Leaf 6]; P [Leaf 7; Leaf 8]; Leaf 9; Leaf 10; Leaf 11])
+  |> Option.map Canonical.canonical
+  |> Option.map to_string
+  |> Option.value ~default:"not an interval"
+  |> print_endline;
+  [%expect{|
+    Q[Leaf 2;Leaf 1;Leaf 3;Leaf 4;Leaf 5;Leaf 6;Leaf 8;Leaf 7;Leaf 9;Leaf 10;
+        Leaf 11] |}]
+

test/unit/imperativeBLtest.ml

+open PqTreeLib
+open PqTree 
+
+let run pqtree interval = 
+  let algos = ImperativeBL.get_algorithms pqtree (fun i -> i-1) in 
+  let _ = algos.insert interval in
+  algos.get ()
+  |> RobinsonTest.IntPqTree.to_string 
+  |> print_endline
+
+
+let pqtree1 =
+  P
+    [Q
+       [Leaf 1; Leaf 2;
+        P
+          [P
+             [Leaf 3;
+              P
+                [Leaf 4;
+                 P
+                   [Leaf 5;
+                    Q
+                      [Leaf 6;
+                       P
+                         [Q
+                            [Leaf 7; Q [Leaf 8; Leaf 9; Leaf 10; Leaf 11; Leaf 12];
+                             Leaf 13; Leaf 14; Leaf 15; Leaf 16; Leaf 17; Leaf 18;
+                             Leaf 19; Leaf 20;
+                             P
+                               [Leaf 21; Leaf 22; Leaf 23; Leaf 24; Leaf 25; Leaf 26;
+                                Leaf 27; Leaf 28; Leaf 29]];
+                          Leaf 30; Q [Leaf 31; Leaf 32; Leaf 33]];
+                       Leaf 34];
+                    P [Leaf 35; P [Leaf 36; Leaf 37; Leaf 38]; Leaf 39]]]];
+           Leaf 40];
+        Leaf 41];
+     P [Leaf 42; Leaf 43]]
+let interval1 = [8;9;10;11;12;13] 
+
+
+let%expect_test _ = 
+  run pqtree1 interval1;
+  [%expect{|
+    P[Q[Leaf 1;Leaf 2;
+          P[P[Leaf 3;
+                P[Leaf 4;
+                    P[Leaf 5;
+                        Q[Leaf 6;
+                            P[Q[Leaf 7;Q[Leaf 8;Leaf 9;Leaf 10;Leaf 11;Leaf 12];
+                                  Leaf 13;Leaf 14;Leaf 15;Leaf 16;Leaf 17;
+                                  Leaf 18;Leaf 19;Leaf 20;
+                                  P[Leaf 21;Leaf 22;Leaf 23;Leaf 24;Leaf 25;
+                                      Leaf 26;Leaf 27;Leaf 28;Leaf 29]];Leaf 30;
+                                Q[Leaf 31;Leaf 32;Leaf 33]];Leaf 34];
+                        P[Leaf 35;P[Leaf 36;Leaf 37;Leaf 38];Leaf 39]]]];
+              Leaf 40];Leaf 41];P[Leaf 42;Leaf 43]] |}]
+
+
+let pqtree2 = 
+  Q [
+      Leaf 1;
+      P [
+          Q [ 
+              P [ 
+                  Leaf 2;
+                  P [ 
+                      Leaf 3; 
+                      P [Leaf 4;Leaf 5]; 
+                      P[ P [Leaf 6;Leaf 7]; Leaf 8]
+                    ];
+                  P [Leaf 9; Leaf 10];
+                  Leaf 11
+                ];
+              P [ 
+                  Leaf 12;
+                  Q [Leaf 13; Leaf 14; Leaf 15]
+                ];
+              Leaf 16
+            ];
+          Leaf 17;
+          Leaf 18
+        ];
+      Leaf 19
+    ]
+let interval2 = [8; 7; 6; 5; 4; 3; 2]
+
+let%expect_test _ = 
+  run pqtree2 interval2;
+  [%expect{|
+    Q[Leaf 1;
+        P[Q[P[P[Leaf 9;Leaf 10];Leaf 11;
+                P[P[Leaf 3;P[Leaf 4;Leaf 5];P[P[Leaf 6;Leaf 7];Leaf 8]];Leaf 2]];
+              P[Leaf 12;Q[Leaf 13;Leaf 14;Leaf 15]];Leaf 16];Leaf 17;Leaf 18];
+        Leaf 19] |}]
+
+
+
+
+
+let speed_test n =
+  let open DataStruct in 
+  let elts = MoreList.range 0 (n-1) in 
+  let pairs = 
+    elts 
+    |> MoreList.consecutives
+    |> Combi.Combinatorics.random_permutation
+  in 
+  let leaves = List.map (fun i -> Leaf i) elts in
+  let universal = P leaves in 
+  let flat = Q leaves in 
+  let algos = ImperativeBL.get_algorithms universal (fun i -> i) in 
+  List.iter (fun (i,j) -> assert (algos.insert [i;j])) pairs;
+  RobinsonTest.IntPqTree.Canonical.compare flat (algos.get ()) = 0
+
+
+
+let%test _ = 
+  speed_test 100000
+
+        
+                     
+