From mboxrd@z Thu Jan 1 00:00:00 1970 X-Sympa-To: caml-list@inria.fr Received: from mail1-relais-roc.national.inria.fr (mail1-relais-roc.national.inria.fr [192.134.164.82]) by walapai.inria.fr (8.13.6/8.13.6) with ESMTP id p621nXYo023413 for ; Sat, 2 Jul 2011 03:49:38 +0200 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AhgCADd4Dk6CQBcymWdsb2JhbABSmQ6OcxQBAQEBAQgLCwcUJYh5uROIeoYyBKJ/ X-IronPort-AV: E=Sophos;i="4.65,461,1304287200"; d="ml'?scan'208";a="112370805" Received: from sunfire42.eecs.tufts.edu ([130.64.23.50]) by mail1-smtp-roc.national.inria.fr with ESMTP; 02 Jul 2011 03:49:37 +0200 Received: from pmx.eecs.tufts.edu (sunfire43.eecs.tufts.edu [130.64.23.79]) by sunfire42.eecs.tufts.edu (Postfix) with ESMTP id 93635C0005 for ; Fri, 1 Jul 2011 21:49:28 -0400 (EDT) Received: from pmx.eecs.tufts.edu (localhost [127.0.0.1]) by localhost (Postfix) with SMTP id 5B38810F3D00 for ; Fri, 1 Jul 2011 21:49:28 -0400 (EDT) Received: from labrador.cs.tufts.edu (labrador.eecs.tufts.edu [130.64.23.84]) by pmx.eecs.tufts.edu (Postfix) with ESMTP id DA37110F3538 for ; Fri, 1 Jul 2011 21:49:27 -0400 (EDT) Received: by labrador.cs.tufts.edu (Postfix, from userid 32074) id DFB9D601DAF4C; Fri, 1 Jul 2011 21:49:25 -0400 (EDT) To: caml-list@inria.fr In-reply-to: <4E0CAEC3.7010804@gmail.com> (sfid-j-20110630-131704-+2.76-1@multi.osbf.lua) References: <4E0CAEC3.7010804@gmail.com> (sfid-j-20110630-131704-+2.76-1@multi.osbf.lua) Comments: In-reply-to Andrew message dated "Thu, 30 Jun 2011 19:13:39 +0200." MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="----- =_aaaaaaaaaa0" Content-ID: <12156.1309571352.0@labrador.cs.tufts.edu> Date: Fri, 01 Jul 2011 21:49:22 -0400 From: Norman Ramsey Message-Id: <20110702014925.DFB9D601DAF4C@labrador.cs.tufts.edu> X-PMX-Version: 5.6.1.2065439, Antispam-Engine: 2.7.2.376379, Antispam-Data: 2011.7.2.13914 X-PMX-Spam: Gauge=X, Probability=10%, Report=' TO_IN_SUBJECT 0.5, MIME_TEXT_ONLY_MP_MIXED 0.05, BODYTEXTP_SIZE_3000_LESS 0, BODY_SIZE_3000_3999 0, BODY_SIZE_5000_LESS 0, BODY_SIZE_7000_LESS 0, NO_URI_FOUND 0, __BOUNCE_CHALLENGE_SUBJ 0, __BOUNCE_NDR_SUBJ_EXEMPT 0, __CANPHARM_COPYRIGHT 0, __CP_NAME_BODY 0, __CT 0, __CTYPE_HAS_BOUNDARY 0, __CTYPE_MULTIPART 0, __CTYPE_MULTIPART_MIXED 0, __HAS_MSGID 0, __MIME_TEXT_ONLY 0, __MIME_VERSION 0, __SANE_MSGID 0, __SUBJ_ALPHA_END 0, __TO_MALFORMED_2 0, __TO_NO_NAME 0' X-Validation-by: nr@cs.tufts.edu Subject: Re: [Caml-list] Priority queues, reloaded ------- =_aaaaaaaaaa0 Content-Type: text/plain; charset="us-ascii" Content-ID: <12156.1309571352.1@labrador.cs.tufts.edu> > Since the previous discussion regarding priority queues pretty much > concluded that they weren't available in OCaml, could you point to the most > compact implementation that you know of? Attached find a transliteration of some Standard ML code I wrote last summer. The SML was tested; the transliteration is not. But it does compile, and I've put it under CC BY license: attribution required, all uses permitted. Norman ------- =_aaaaaaaaaa0 Content-Type: text/plain; name="leftistheap.ml"; charset="us-ascii" Content-ID: <12156.1309571352.2@labrador.cs.tufts.edu> (* Leftist heap (priority queue) by Norman Ramsey *) (* Copyright 2011, licensed Creative Commons Attribution (BY), i.e., attribution required, but all uses permitted *) module type PQUEUE = sig type t type elem val empty : t val insert : elem * t -> t val is_empty : t -> bool exception Empty val deletemin : t -> elem * t (* raises Empty *) val ok : t -> bool (* satisfies invariant *) val merges : int ref end module MkTreePQ (Elem : sig type t val compare : t * t -> int end) : PQUEUE with type elem = Elem.t = struct type elem = Elem.t type height = int type t = EMPTY | NODE of elem * height * t * t (* invariant: elem in a node is not greater than the elems in its nonempty children left child is at least as high as right child height represents true height *) let le (x1, x2) = Elem.compare (x1, x2) <= 0 let rec height = function | EMPTY -> 0 | (NODE (_, h, _, _)) -> h let merges = ref 0 let rec merge = function | (EMPTY, q) -> q | (q, EMPTY) -> q | ((NODE (x1, _, l1, r1) as q1), (NODE (x2, _, _, _) as q2)) -> if le (x1, x2) then let (to_merge, to_stand) = if height l1 > height q2 then (q2, l1) else (l1, q2) in let newq1 = merge (r1, to_merge) in let newq2 = to_stand in let h1 = height newq1 in let h2 = height newq2 in let h = max h1 h2 + 1 in let (l, r) = if h1 > h2 then (newq1, newq2) else (newq2, newq1) in let _ = merges := !merges + 1 in NODE (x1, h, l, r) else merge (q2, q1) let empty = EMPTY let rec insert = function | (x, EMPTY) -> NODE (x, 1, EMPTY, EMPTY) | (x, q) -> merge (insert(x, empty), q) let is_empty = function | EMPTY -> true | (NODE _) -> false exception Empty let deletemin = function | EMPTY -> raise Empty | (NODE (x, _, q, q')) -> (x, merge (q, q')) let rec ok_h_le h x q = (* q satisfies invariant, has height h, each elem at least x *) match q with | EMPTY -> h = 0 | NODE (x', h', l, r) -> h = h' && le(x, x') && (h = height l + 1 || h = height r + 1) && h > height l && h > height r && ok_h_le (height l) x' l && ok_h_le (height r) x' r let ok = function | EMPTY -> true | (NODE (x, h, _, _) as q) -> ok_h_le h x q end ------- =_aaaaaaaaaa0--