Commit b8618979 authored by Maximilien Colange's avatar Maximilien Colange

Remove inefficient sorted list representation for waiting lists.

Use the existing (yet a bit hidden) implementation based on balanced trees instead.
parent c8b80c06
......@@ -147,10 +147,8 @@ struct
Arg.String (function
| "BFS" -> walk_order := (module Waiting.Walk_BFS : PARTIAL_WO)
| "DFS" -> walk_order := (module Waiting.Walk_DFS : PARTIAL_WO)
| "BBFS" -> walk_order := (module Waiting.BBFS : PARTIAL_WO)
| "BDFS" -> walk_order := (module Waiting.BDFS : PARTIAL_WO)
| "BBFST" -> walk_order := (module Waiting.BBFST : PARTIAL_WO)
| "BDFST" -> walk_order := (module Waiting.BDFST : PARTIAL_WO)
| "BBFS" -> walk_order := (module Waiting.BBFST : PARTIAL_WO)
| "BDFS" -> walk_order := (module Waiting.BDFST : PARTIAL_WO)
| "SBFS" -> walk_order := (module Best_wait.WSTS_WO : PARTIAL_WO)
| _ -> raise (Arg.Bad "Invalid argument for option -order")),
" Sets the order in which the RG is explored:
......
......@@ -37,69 +37,9 @@ module Walk_DFS = Walk_Order_Opt (WOStack)
module Walk_BFS = Walk_Order_Opt (WOQueue)
(**
* A custom, circular list, that allows inplace insertion, to keep it sorted
* A custom tree to represent sorted sets, with inplace insertion.
* Inspired by the representation of Sets in the standard library.
*)
module MyList (T : sig val threshold : int end) : WAIT_CONTAINER =
functor (Elem : WaitOrderedType) ->
struct
exception Empty
type cell = { content : Elem.t; mutable next : cell; }
type t = { mutable length : int; mutable tail : cell; }
let create () =
{ length = 0; tail = Obj.magic None; }
(* insert as soon as x <= y [Stack] *)
let _should_insert x y = Elem.compare x y < T.threshold
let rec _push_aux c x l =
(* should x be inserted before c.next? *)
if (_should_insert x c.next.content) then
let newcell = { content = x; next = c.next; } in
c.next <- newcell;
l.length <- l.length + 1;
(* if we have reached the end of the list *)
else if (c.next == l.tail) then
let newcell = { content = x; next = c.next.next (*head*); } in
c.next.next <- newcell;
l.tail <- newcell;
l.length <- l.length + 1;
(* go to next element in the list *)
else
_push_aux c.next x l
let push x l =
if l.length = 0 then (
let rec cell = {
content = x;
next = cell;
}
in
l.length <- 1;
l.tail <- cell
) else (
_push_aux l.tail x l
)
let pop l =
if l.length = 0 then raise Empty;
let res = l.tail.next.content in
if l.length = 1 then (
l.tail <- Obj.magic None
) else (
l.tail.next <- l.tail.next.next
);
l.length <- l.length - 1;
res
let is_empty l = l.length = 0
let length l = l.length
end
(* Rework the ordered list as a binary tree *)
(* Inspired by the representation of Sets in the standard library *)
module MyBTree (T : sig val threshold : int end) : WAIT_CONTAINER =
functor (Elem : WaitOrderedType) ->
struct
......@@ -270,7 +210,6 @@ end
* insert an element x before y as soon as x <= y
* i.e. compare x y < 1
*)
module Priority_Stack : WAIT_CONTAINER = MyList (struct let threshold = 1 end)
module Priority_StackTree : WAIT_CONTAINER = MyBTree (struct let threshold = 1 end)
(*
......@@ -278,12 +217,9 @@ module Priority_StackTree : WAIT_CONTAINER = MyBTree (struct let threshold = 1 e
* insert an element x before y as soon as x < y
* i.e. compare x y < 0
*)
module Priority_Queue : WAIT_CONTAINER = MyList (struct let threshold = 0 end)
module Priority_QueueTree : WAIT_CONTAINER = MyBTree (struct let threshold = 0 end)
module BDFS = Walk_Order_Opt (Priority_Stack)
module BDFST = Walk_Order_Opt (Priority_StackTree)
module BBFS = Walk_Order_Opt (Priority_Queue)
module BBFST = Walk_Order_Opt (Priority_QueueTree)
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