mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
graph now uses Heap rather than Leftistheap
This commit is contained in:
Simon Cruanes
parent
2e19b5eb1a
commit
009afc575b
3 changed files with 7 additions and 151 deletions
17
graph.ml
17
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue