Sorted list
[
Home
]
[ Index:
by date

by threads
]
[ Message by date: previous  next ] [ Message in thread: previous  next ] [ Thread: previous  next ]
[ Message by date: previous  next ] [ Message in thread: previous  next ] [ Thread: previous  next ]
Date:   (:) 
From:  Brian Hurt <bhurt@s...> 
Subject:  Re: [Camllist] Sorted list 
On Sat, 4 Aug 2007, tmp123@menta.net wrote: > Hello, > > In order to implement a timers subsystem, I need a module with the following > values: > > *) add_timer : time > ( unit > unit ) > timerid, > for public usage, where "add_timer t f" means execute "f" at time "t". The > result is an identifier who allows cancelation of the timer. > *) cancel_timer: timerid > unit > for public usage, cancel a previously added timer > *) peek_minimum_timer : unit > ( time, unit > unit ) > for internal usage, get the timer with minimum time. Returns the time and the > related function. > *) remove_minimum_timer : ?? > unit > for internal usage, remove the timer with the minimum time. It will be called > after execute a timer. > > Thus, in a generic sense, what I need is a "sorted list", with easy insertion > of elements, and peek/pop of the head (minimum). > > Of the standard modules, the most similar seems "set", because allows > insertion and has the funcion "min_elt". However, the problem is, if two > timers have the same time, addition of the second one removes the first. > > Please, has someone any sugestion? What you want is a priority queue. Here's a simple one: a leftist priority queue. The core operation is join, which takes two priority queues and joins them together: module type Req = sig type t val compare : t > t > int end module Make(Ord: Req) = struct type elem = Ord.t;; type t =  Node of int * t * Ord.t * t  Empty ;; let height = function  Empty > 0  Node(h, _, _, _) > h ;; let join p q = match p, q with  Empty, Empty > Empty  Empty, _ > q  _, Empty > p  Node(_, pl, px, pr), Node(_, ql, qx, qr) > let x, l, m, r = if (Ord.compare px qx) <= 0 then px, pl, pr, q else qx, p ql, qr in (* pick the tallest of l, m, and r to be the new left * node. The new right node is the join of the remaining * two nodes. *) let left, right = if (height l) >= (height m) then if (height l) >= (height r) then l, (join m r) else r, (join l m) else if (height m) >= (height r) then m, (join l r) else r, (join l m) in let h = 1 + (max (height left) (height right)) in Node(h, left, x, right) ;; let empty = Empty;; let singelton x = Node(1, Empty, x, Empty);; let is_empty = function  Empty > true  Node(_, _, _, _) > false ;; let get_head = function  Empty > invalid_arg "head on empty priority queue!"  Node(_, _, x, _) > x ;; let remove_head = function  Empty > invalid_arg "remove_head on empty priority queue!"  Node(_, l, _, r) > join l r ;; let add q x = let p = singleton x in join q p ;; let rec filter f = function  Empty > Empty  Node(_, l, x, r) > if f x then join (join (filter l) (singleton x)) (filter r) else join (filter l) (filter r) ;; The one problem with this is that filter is O(N log N). I'd probably just add a bit of mutable data to the timer structure, a boolean flag to say wether it's been deleted our not. Then, when you remove the head node, you keep removing the head node while it's been deleted (i.e. a deleted node doesn't get removed until it times out). If the number of deleted nodes reaches some sufficiently high percentage, you can then afford to filter the whole table and delete all of them at once. Brian