From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.1.3 (2006-06-01) on yquem.inria.fr X-Spam-Level: X-Spam-Status: No, score=0.0 required=5.0 tests=none autolearn=disabled version=3.1.3 X-Original-To: caml-list@yquem.inria.fr Delivered-To: caml-list@yquem.inria.fr Received: from concorde.inria.fr (concorde.inria.fr [192.93.2.39]) by yquem.inria.fr (Postfix) with ESMTP id 81224BC68 for ; Mon, 16 Oct 2006 11:25:35 +0200 (CEST) Received: from shiva.jussieu.fr (shiva.jussieu.fr [134.157.0.129]) by concorde.inria.fr (8.13.6/8.13.6) with ESMTP id k9G9PZZ4004995 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NO) for ; Mon, 16 Oct 2006 11:25:35 +0200 Received: from courriel.upmc.fr (courriel3.reseau.jussieu.fr [134.157.0.194]) by shiva.jussieu.fr (8.13.7/jtpda-5.4) with ESMTP id k9G9PF16049320 ; Mon, 16 Oct 2006 11:25:15 +0200 (CEST) X-Ids: 164 Received: from etu.upmc.fr (localhost [127.0.0.1]) by courriel.upmc.fr (8.13.6/jtpda-5.4) with ESMTP id k9G9PFnq027171 ; Mon, 16 Oct 2006 11:25:15 +0200 (CEST) Received: from out-of.ilog.fr (out-of.ilog.fr [81.80.159.49]) by webmail.etu.upmc.fr (Horde MIME library) with HTTP; Mon, 16 Oct 2006 11:25:15 +0200 Message-ID: <20061016112515.ircc0o7sgsssowcs@webmail.etu.upmc.fr> Date: Mon, 16 Oct 2006 11:25:15 +0200 From: Diego Olivier FERNANDEZ PONS To: Pietro Abate Cc: caml-list@inria.fr Subject: Re: [Caml-list] Reordering continuations (was :Type inference inside exceptions ?) References: <20061006201647.1a88vj0tkockc4k8@webmail.etu.upmc.fr> <452D753E.1020607@glondu.net> <20061013142317.z70cu8q30g40gckc@webmail.etu.upmc.fr> <20061013124223.GA30832@pulp.rsise.anu.edu.au> <20061014215653.by7emka3kgscccsc@webmail.etu.upmc.fr> In-Reply-To: <20061014215653.by7emka3kgscccsc@webmail.etu.upmc.fr> MIME-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1; DelSp="Yes"; format="flowed" Content-Disposition: inline Content-Transfer-Encoding: quoted-printable User-Agent: Internet Messaging Program (IMP) H3 (4.1.3) X-Virus-Scanned: ClamAV 0.88.2/2035/Sun Oct 15 22:42:30 2006 on shiva.jussieu.fr X-Virus-Scanned: ClamAV version 0.88.4, clamav-milter version 0.88.4 on courriel3.reseau.jussieu.fr X-Virus-Status: Clean X-Greylist: Sender IP whitelisted, not delayed by milter-greylist-2.0.2 (shiva.jussieu.fr [134.157.0.164]); Mon, 16 Oct 2006 11:25:15 +0200 (CEST) X-Miltered: at concorde with ID 4533500F.000 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)! X-Miltered: at shiva.jussieu.fr with ID 45334FFB.002 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)! X-Spam: no; 0.00; pons:01 pons:01 reordering:01 inference:01 reordering:01 stack:01 subset:01 discrepancy:01 stack:01 bool:01 val:01 val:01 mutable:01 mutable:01 nodes:01 Bonjour, Here is some code that shows the effect of reordering continuations in =20 a combinatorial problem. The first one is the minimum cardinality =20 subset-sum problem, the second returns the order in which the leaves =20 of the search tree are visited. Each time a solution is found, the number of failures is printed. This =20 gives an idea of how much time was spent to find the solution. (* subsetsum in depth first search *) # let p =3D smc 47 [39;32;20;19;16;9;1] in solve p (new stack);; 0 fails : 39 1 1 1 1 1 1 1 1 8 fails : 32 9 1 1 1 1 1 1 47 fails : 20 16 9 1 1 61 fails : 20 9 9 9 118 fails : 19 19 9 - : int list list * int =3D ([[39; 1; 1; 1; 1; 1; 1; 1; 1]; [32; 9; 1; 1; 1; 1; 1; 1]; [20; 16; 9; 1; 1]= ; [20; 9; 9; 9]; [19; 19; 9]], 457) (* subset sum in limited discrepancy search *) # let p =3D smc 47 [39;32;20;19;16;9;1] in solve p (new queue);; 0 fails : 39 1 1 1 1 1 1 1 1 0 fails : 32 9 1 1 1 1 1 1 16 fails : 19 19 9 - : int list list * int =3D ([[39; 1; 1; 1; 1; 1; 1; 1; 1]; [32; 9; 1; 1; 1; 1; 1; 1]; [19; 19; 9]], 459 The second example builds a tree which leaves are labelled from 0 to =20 2^n - 1 from left to right. The order in which the leaves are visited =20 is returned. # let p =3D label 4 in solve p (new stack);; - : int list * int =3D ([0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15], 0) # let p =3D label 4 in solve p (new queue);; - : int list * int =3D ([0; 8; 4; 2; 1; 12; 10; 9; 6; 5; 3; 14; 13; 11; 7; 15], 0) Here is the complete code class type ['a] continuationQueue =3D object method push : 'a -> unit method pop : 'a method is_empty : bool method length : int end class ['a] queue =3D (object val contents =3D (Queue.create () : 'a Queue.t) method push =3D fun x -> Queue.push x contents method pop =3D Queue.pop contents method is_empty =3D Queue.is_empty contents method length =3D Queue.length contents end : ['a] continuationQueue) class ['a] stack =3D (object val contents =3D (Stack.create () : 'a Stack.t) method push =3D fun x -> Stack.push x contents method pop =3D Stack.pop contents method is_empty =3D Stack.is_empty contents method length =3D Stack.length contents end : ['a] continuationQueue) type 'a environment =3D { mutable backtracks : int; mutable objective : int; mutable queue : 'a queue } exception Fail type 'a continuation =3D Cont of (unit -> 'a) let rec print_list =3D function | [] -> print_newline() | x :: tail -> print_int x; print_string " "; print_list tail let rec min_card env =3D fun to_reach chosen candidates -> if (to_reach =3D 0) then match compare env.objective (List.length chosen) with | n when n <=3D 0 -> =09env.backtracks <- env.backtracks + 1; =09raise Fail | _ -> =09env.objective <- List.length chosen; =09print_int env.backtracks; =09print_string " fails : "; =09print_list (List.rev chosen); =09(List.rev chosen) else match candidates with | [] -> =09env.backtracks <- env.backtracks + 1; =09raise Fail | x :: tail when x > to_reach -> min_card env to_reach chosen tail | x :: tail -> =09let c =3D Cont (fun () -> min_card env to_reach chosen tail) in =09env.queue#push c; =09min_card env (to_reach - x) (x :: chosen) candidates let smc =3D fun to_reach list -> function env -> let c =3D Cont (function () -> min_card env to_reach [] list) in env.queue#push c; env let rec label_nodes env =3D fun count remaining_depth -> match remaining_depth with | 0 -> count | n -> =09let c =3D Cont (fun () -> label_nodes env (2 * count + 1) (n - 1)) in =09 env.queue#push c; =09 label_nodes env (2 * count) (n - 1) let label =3D function depth -> function env -> let c =3D Cont (fun () -> label_nodes env 0 depth) in env.queue#push c; env let rec solve_rec =3D function env -> if env.queue#is_empty then [] else let Cont c =3D env.queue#pop in try let s =3D c () in s :: solve_rec env with Fail -> solve_rec env let solve =3D fun f queue -> let env =3D { backtracks =3D 0; objective =3D max_int; queue =3D queue } = in let solutions =3D solve_rec (f env) in (solutions, env.backtracks) Diego Olivier