Commit 4dbe8096 authored by Guyslain Naves's avatar Guyslain Naves

Improved the way lazy lists are generated.

Add implementation using () -> 'a instead of 'a Lazy.t (no need for memo)
parent 46acf767
......@@ -62,37 +62,25 @@ struct
| Cons of 'elt * 'elt lazy_list
and 'elt lazy_list = 'elt lazy_cell Lazy.t
let cons elt lazy_list = lazy (Cons (elt, lazy_list))
let rec append llist1 llist2 =
lazy (match Lazy.force llist1 with
| Nil -> Lazy.force llist2
| Cons (first, tail) -> Cons (first, append tail llist2)
)
let rec lazy_increasing_elements tree =
lazy (
match tree with
| Empty -> Nil
let lazy_increasing_elements tree =
let rec loop accu = function
| Empty ->
accu
| Node node ->
Lazy.force
(append
(lazy_increasing_elements node.left)
(cons node.key (lazy_increasing_elements node.right))
)
)
loop (Cons (node.key, lazy (loop accu node.right))) node.left
in
lazy (loop Nil tree)
let rec lazy_decreasing_elements tree =
lazy (
match tree with
| Empty -> Nil
let rec loop accu = function
| Empty ->
accu
| Node node ->
Lazy.force
(append
(lazy_decreasing_elements node.right)
(cons node.key (lazy_decreasing_elements node.left))
)
)
loop (Cons (node.key, lazy (loop accu node.left))) node.right
in
lazy (loop Nil tree)
let rec find_pair sum increasing decreasing =
......@@ -116,6 +104,58 @@ struct
end
module UsingSimiliLazyLists : PairFinder =
struct
let name = "simili lazy lists"
type 'elt lazy_cell =
| Nil
| Cons of 'elt * 'elt lazy_list
and 'elt lazy_list = unit -> 'elt lazy_cell
let lazy_increasing_elements tree =
let rec loop accu = function
| Empty ->
accu
| Node node ->
loop (Cons (node.key, (fun () -> loop accu node.right))) node.left
in
fun () -> loop Nil tree
let rec lazy_decreasing_elements tree =
let rec loop accu = function
| Empty ->
accu
| Node node ->
loop (Cons (node.key, (fun () -> loop accu node.left))) node.right
in
fun () -> loop Nil tree
let rec find_pair sum increasing decreasing =
match increasing (), decreasing () with
| Cons (elt1,tail1), Cons (elt2,tail2) when elt2 < elt1 ->
None
| Cons (elt1,tail1), Cons (elt2,tail2) when elt1 + elt2 = sum ->
Some (elt1,elt2)
| Cons (elt1,tail1), Cons (elt2,tail2) when elt1 + elt2 > sum ->
find_pair sum increasing tail2
| Cons (elt1, tail1), Cons (elt2,tail2) (* when elt1 + elt2 < sum *) ->
find_pair sum tail1 decreasing
| _ -> None
let solve sum tree =
find_pair sum
(lazy_increasing_elements tree)
(lazy_decreasing_elements tree)
end
module UsingGenerators : PairFinder =
struct
let name = "generators"
......@@ -330,9 +370,9 @@ struct
list_init (fun _ -> mini + Random.int (maxi - mini)) n
let satisfiable_instance ~ratio ~n =
assert (ratio > 0. && ratio < 0.5);
assert (ratio > 0. && ratio <= 0.5);
let nb_sides = int_of_float (ratio *. float n) in
let nb_middle = n - 2 * nb_sides in
let nb_middle = max 0 (n - 2 * nb_sides) in
let below =
fully_random_list ~mini:0 ~maxi:n nb_sides
|> List.map (( * ) 4)
......@@ -357,6 +397,7 @@ end
let implementations =
[ (module UsingLists : PairFinder);
(module UsingLazyLists : PairFinder);
(module UsingSimiliLazyLists : PairFinder);
(module UsingGenerators : PairFinder);
(module UsingZippers : PairFinder)
]
......@@ -385,7 +426,7 @@ let benchmarks ~ratio ~size ~nb_instances =
let main =
let size = 10000 in
let ratio = 0.1 in
let ratio = 0.2 in
let nb_instances = 2 in
benchmarks ~ratio ~size ~nb_instances
|> Core_bench.Bench.make_command
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment