From 009afc575bf5294a04b47b73a9ec6bf3a3602e6c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 5 Mar 2013 11:08:26 +0100 Subject: [PATCH] graph now uses Heap rather than Leftistheap --- graph.ml | 17 ++++------ leftistheap.ml | 86 ------------------------------------------------- leftistheap.mli | 55 ------------------------------- 3 files changed, 7 insertions(+), 151 deletions(-) delete mode 100644 leftistheap.ml delete mode 100644 leftistheap.mli diff --git a/graph.ml b/graph.ml index 375b790d..3346463d 100644 --- a/graph.ml +++ b/graph.ml @@ -244,18 +244,15 @@ exception ExitBfs satisfies [goal]. *) let min_path_full (type v) (type e) graph ?(cost=fun _ _ _ -> 1) ?(ignore=fun _ -> false) ~goal v = - let module HQ = Leftistheap.Make(struct - type t = v * int * (v, e) path - let le (_,i,_) (_,j,_) = i <= j - end) in - let q = ref HQ.empty in + (* priority queue *) + let cmp (_,i,_) (_,j,_) = i - j in + let q = Heap.empty ~cmp in let explored = mk_v_set graph in - q := HQ.insert (v, 0, []) !q; + Heap.insert q (v, 0, []); let best_path = ref (v,0,[]) in try - while not (HQ.is_empty !q) do - let (v, cost_v, path), q' = HQ.extract_min !q in - q := q'; + while not (Heap.is_empty q) do + let (v, cost_v, path) = Heap.pop q in if Hashset.mem explored v then () (* a shorter path is known *) else if ignore v then () (* ignore the node. *) else if goal v path (* shortest path to goal node! *) @@ -269,7 +266,7 @@ let min_path_full (type v) (type e) graph else let cost_v' = (cost v e v') + cost_v in let path' = (v',e,v) :: path in - q := HQ.insert (v', cost_v', path') !q) + Heap.insert q (v', cost_v', path')) (next graph v) end done; diff --git a/leftistheap.ml b/leftistheap.ml deleted file mode 100644 index 3e315f1e..00000000 --- a/leftistheap.ml +++ /dev/null @@ -1,86 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (C) Jean-Christophe Filliatre *) -(* *) -(* This software is free software; you can redistribute it and/or *) -(* modify it under the terms of the GNU Library General Public *) -(* License version 2.1, with the special exception on linking *) -(* described in file LICENSE. *) -(* *) -(* This software is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) -(* *) -(**************************************************************************) - -(* Leftist heaps. - - See for instance Chris Okasaki's "Purely Functional Data Structures". *) - -exception Empty - -(* ----------------------------------------------------------------------------- - functor interface - ----------------------------------------------------------------------------- *) - -module type Ordered = sig - type t - val le: t -> t -> bool -end - -module Make(X : Ordered) : -sig - type t - val empty : t - val is_empty : t -> bool - val insert : X.t -> t -> t - val min : t -> X.t - val extract_min : t -> X.t * t - val merge : t -> t -> t - val filter: t -> (X.t -> bool) -> t - val remove: t -> X.t list -> t -end -= -struct - - type t = E | T of int * X.t * t * t - - let rank = function E -> 0 | T (r,_,_,_) -> r - - let make x a b = - let ra = rank a and rb = rank b in - if ra >= rb then T (rb + 1, x, a, b) else T (ra + 1, x, b, a) - - let empty = E - - let is_empty = function E -> true | T _ -> false - - let rec merge h1 h2 = match h1,h2 with - | E, h | h, E -> - h - | T (_,x,a1,b1), T (_,y,a2,b2) -> - if X.le x y then make x a1 (merge b1 h2) else make y a2 (merge h1 b2) - - let insert x h = merge (T (1, x, E, E)) h - - let min = function E -> raise Empty | T (_,x,_,_) -> x - - let extract_min = function - | E -> raise Empty - | T (_,x,a,b) -> x, merge a b - - let rec filter t pred = match t with - | E -> E - | T (_, x, a, b) when pred x -> insert x (merge (filter a pred) (filter b pred)) - | T (_, _, a, b) -> merge (filter a pred) (filter b pred) - - let rec remove t l = match t with - | E -> E - | T (_,x,a,b) when List.exists (fun y -> X.le x y && X.le y x) l -> - (* eliminate x, it is in the list if X.le is a total order *) - merge (remove a l) (remove b l) - | T (_,x,a,b) -> - make x (remove a l) (remove b l) - -end - diff --git a/leftistheap.mli b/leftistheap.mli deleted file mode 100644 index d6e854bb..00000000 --- a/leftistheap.mli +++ /dev/null @@ -1,55 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (C) Jean-Christophe Filliatre *) -(* *) -(* This software is free software; you can redistribute it and/or *) -(* modify it under the terms of the GNU Library General Public *) -(* License version 2.1, with the special exception on linking *) -(* described in file LICENSE. *) -(* *) -(* This software is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) -(* *) -(**************************************************************************) - -(* Leftist heaps *) - -(* ----------------------------------------------------------------------------- - functor interface - ----------------------------------------------------------------------------- *) - -module type Ordered = sig - type t - val le: t -> t -> bool -end - -exception Empty - -module Make(X: Ordered) : -sig - type t - - val empty: t - - val is_empty: t -> bool - (* runs in O(1) *) - - val insert: X.t -> t -> t - (* runs in O(log n) *) - - val min: t -> X.t - (* runs in O(1) *) - - val extract_min: t -> X.t * t - (* runs in O(log n) *) - - val merge: t -> t -> t - (* runs in O(log max(n1, n2)) *) - - val filter: t -> (X.t -> bool) -> t - (* O(n ln(N))? keep only the elements that satisfy the predicate *) - - val remove: t -> X.t list -> t - (* runs in O(n), removing all elements in the list (assuming X.le is total) *) -end