Skip to content
Snippets Groups Projects
Commit ef3e0cbb authored by Guyslain Naves's avatar Guyslain Naves
Browse files

Initial commit

parents
No related branches found
No related tags found
No related merge requests found
Showing with 845 additions and 0 deletions
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
(library
(name main_prop_test)
(libraries PqTreeLib RobinsonLib Recognition qcheck RobinsonTest)
(inline_tests)
(preprocess (pps ppx_inline_test))
)
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;
]
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;
]
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
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;
]
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
]
val tests : QCheck2.Test.t list
(library
(name RobinsonTest)
(libraries RobinsonLib PqTreeLib RandomDissimilarity feat fix qcheck)
(instrumentation (backend landmarks))
)
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 ()
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
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)
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
(library
(name RobinsonUnit)
(libraries RobinsonLib RobinsonTest)
(inline_tests)
(preprocess (pps ppx_inline_test ppx_expect))
)
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] |}]
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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment