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 mail3-relais-sop.national.inria.fr (mail3-relais-sop.national.inria.fr [192.134.164.104]) by yquem.inria.fr (Postfix) with ESMTP id 6C19EBBCA for ; Sat, 26 Apr 2008 08:54:09 +0200 (CEST) X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AvEKACxuEkjAXQIm/2dsb2JhbACBU4FKqBQ X-IronPort-AV: E=Sophos;i="4.25,710,1199660400"; d="ml'?scan'208";a="11955692" Received: from discorde.inria.fr ([192.93.2.38]) by mail3-smtp-sop.national.inria.fr with ESMTP; 26 Apr 2008 08:54:08 +0200 Received: from mail4-relais-sop.national.inria.fr (mail4-relais-sop.national.inria.fr [192.134.164.105]) by discorde.inria.fr (8.13.6/8.13.6) with ESMTP id m3Q6s8UB001218 (version=TLSv1/SSLv3 cipher=RC4-SHA bits=128 verify=OK) for ; Sat, 26 Apr 2008 08:54:08 +0200 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: ArsAAPBtEkjUGypAmmdsb2JhbACBU4FKjj4BAQEBAQgFCAcRA5kg X-IronPort-AV: E=Sophos;i="4.25,710,1199660400"; d="ml'?scan'208";a="25522082" Received: from smtp7-g19.free.fr ([212.27.42.64]) by mail4-smtp-sop.national.inria.fr with ESMTP; 26 Apr 2008 08:54:07 +0200 Received: from smtp7-g19.free.fr (localhost [127.0.0.1]) by smtp7-g19.free.fr (Postfix) with ESMTP id 0E42D322817; Sat, 26 Apr 2008 08:54:07 +0200 (CEST) Received: from macbookpro.local (lns-bzn-48f-81-56-220-129.adsl.proxad.net [81.56.220.129]) by smtp7-g19.free.fr (Postfix) with ESMTP id 850753227F8; Sat, 26 Apr 2008 08:54:06 +0200 (CEST) Message-ID: <4812D28E.2050201@univ-savoie.fr> Date: Sat, 26 Apr 2008 08:58:22 +0200 From: Christophe Raffalli User-Agent: Thunderbird 2.0.0.12 (Macintosh/20080213) MIME-Version: 1.0 To: Jon Harrop , OCaml Subject: Re: [Caml-list] Tries are to sequences as ? is to trees References: <200804260220.04921.jon@ffconsultancy.com> In-Reply-To: <200804260220.04921.jon@ffconsultancy.com> Content-Type: multipart/mixed; boundary="------------010200060404030305010802" X-Miltered: at discorde with ID 4812D190.000 by Joe's j-chkmail (http://j-chkmail . ensmp . fr)! X-Spam: no; 0.00; christophe:01 raffalli:01 christophe:01 raffalli:01 univ-savoie:01 hash:01 node:01 constructors:01 cheers:01 univ-savoie:01 implements:01 type-checker:01 redistribute:01 redistribute:01 suitability:01 X-Attachments: name="search_tree.ml" name="search_tree.ml" This is a multi-part message in MIME format. --------------010200060404030305010802 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 8bit Jon Harrop a écrit : > So tries let us associate sequences with values. What data structure lets us > associate trees with values? > > I ask because I am interested in replacing hash consing of expressions with a > purely functional equivalent so I need a way to map expressions onto > expressions. > > The only idea I've come up with so far is to fold over the tree to make a > sequence and use that as the key into a trie but it seems a bit naff... > > I had the same pb and the same idea about fold ... I attached my code which has a lot of missing functions like removal and very special function I needed (search_sub, sub_search, ...). It does a fold of the tree, but via a decomposition function, so you can choose in which order you scan the son of each node. This idea is not so naff. The map library has a complexity in O(N ln(S)) where N is the size of the key and S is the number of item in the table. My current implementation is in O(N P) where P is the number of types of edges (that is the sum of the arities of all constructors). It could be improved in O(N ln(P)) ... but I had no time. Cheers, Christophe --------------010200060404030305010802 Content-Type: text/plain; name="search_tree.ml" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="search_tree.ml" (*====================================================================== Copyright Christophe Raffalli, Universite de Savoie. christophe.raffalli@univ-savoie.fr This software is a computer program which implements an interpreter and type-checker for the PML (Proved Meta-Language) computer language. PML is a language of the ML family with the extra possibility to write and prove the specifications of your code. This software is governed by the CeCILL-B license under French law and abiding by the rules of distribution of free software. You can use, modify and/or redistribute the software under the terms of the CeCILL-B license as circulated by CEA, CNRS and INRIA at the following URL "http://www.cecill.info". The exercising of this freedom is conditional upon a strong obligation of giving credits for everybody that distributes a software incorporating a software ruled by the current license so as all contributions to be properly identified and acknowledged. As a counterpart to the access to the source code and rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors have only limited liability. In this respect, the user's attention is drawn to the risks associated with loading, using, modifying and/or developing or reproducing the software by the user in light of its specific status of free software, that may mean that it is complicated to manipulate, and that also therefore means that it is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the software's suitability as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions as regards security. The fact that you are presently reading this means that you have had knowledge of the CeCILL-B license and that you accept its terms. ======================================================================*) (* This functor provides some specific implementation of maps from "tree" like structure to any other data type *) module type Tree = sig (* This is the type of your "tree" like structure *) type tree (* This is an auxilliary type for the decompose function below *) type accumulator (* This is the type of labels assigned to the edges of your trees, see decompose *) type key (* A total order you must provide on key *) val cmp_key : key -> key -> int (* The decompose function is the function used by the library to read your tree like data structures if "t" is such a tree and "acc" is a parameter you can use while traveling the tree (for simple case, "acc" is just "() : unit"), then decompose t acc must return a list [`C(k1,f1,acc1);`C(k2,f2,acc2;...] with one element for each son of the tree t. k1, k2, ... are labels of type "key" to identify each son. It could also carry information about the top node of "t". (f1 acc1), (f2 acc2), ... should then return the decomposition of each son. The polymorphic variant `C is here just to avoid the -rectypes option of OCaml that would be required if we just used a tuple. *) val decompose : tree -> (accumulator -> [`C of key * 'a * accumulator ] list as 'a) (* the initial value for the second argument of decompose. All functions in the library call "decompose" with "default" as second argument. *) val default : accumulator (* some search functions can ignore some sub trees. "is_flexible k" must return true if edge abelled with "k" can ignore this function. More precisely, is_flexible allows to define an ordering of trees by defining t1 <= t2 if t1 is obtained from t2 by removing some subtree whose edges were labelled with a flexible label. *) val is_flexible : key -> bool (* not documented yet ... *) val is_absorbant : key -> bool end module type Map = sig (* type for your tree *) type tree (* type of a finite map associating value of type 'a to you tree *) type 'a map (* The empty map *) val empty : 'a map (* insert a binding in the map. Existing binding for the same tree are removed *) val insert : tree -> 'a -> 'a map -> 'a map (* search for a binding in a map. raise Not_found if the tree is not in the map *) val search : tree -> 'a map -> 'a (* sub_search t m returns the list of binding for u in m such that u <= t (see is_flexible above for a definition of <=). The same value may be returned more than once. No duplicate result if the map is one-to-one *) val sub_search : tree -> 'a map -> 'a list (* search_sub t m returns the list of binding for u in l such that there exists a subterm of u, u' in m with t <= u'. The same value may be returned more than once, even if the map in one-to-one. *) val search_sub : tree -> 'a map -> 'a list (* remove_search_sub t m performs the same seatch as search_sub be also returns a new map where all the returned binding are removed. No duplicate result if the map is one-to-one *) val remove_search_sub : tree -> 'a map -> ('a map * 'a list) val iter : ('a -> unit) -> 'a map -> unit val fold : ('a -> 'b -> 'b) -> 'a map -> 'b -> 'b end module Make(T: Tree) = (struct type tree = T.tree open T type 'a map = | Empty | Root of 'a | Up of 'a map | Next of key * 'a map * 'a map let empty = Empty let add_data v = function Root _ -> Root v | Empty -> Root v | _ -> assert false let insert t a s0 = let rec insert_aux acc a s = match acc with | [] -> add_data a s | []::acc -> insert_aux'' acc a s | (`C(key,fn,arg)::l)::acc -> insert_aux' (fn arg::l::acc) key a s and insert_aux' acc k a ls = match ls with Root _ | Empty | Up _ -> Next(k, insert_aux acc a Empty, ls) | Next(k',s,ls') -> if cmp_key k k' = 0 then Next(k', insert_aux acc a s,ls') else if cmp_key k k' < 0 then Next(k, insert_aux acc a Empty, ls) else Next(k', s, insert_aux' acc k a ls') and insert_aux'' acc a ls = match ls with Root _ -> assert false | Next(k',s,ls') -> Next(k', s, insert_aux'' acc a ls') | Up(s) -> Up(insert_aux acc a s) | Empty -> Up(insert_aux acc a Empty) in insert_aux [decompose t default] a s0 let rec assoc_up = function Next(_,_,s) -> assoc_up s | Up(s) -> s | _ -> raise Not_found let rec assoc k = function Next(k',s,_) when cmp_key k' k = 0 -> s | Next(k',_,s) when cmp_key k' k < 0 -> assoc k s | _ -> raise Not_found let search t s0 = let rec search_aux acc s = match acc with | [] -> (match s with Root v -> v | _ -> raise Not_found) | ([]::acc) -> let s' = assoc_up s in search_aux acc s' | ((`C(key,fn,arg)::l)::acc) -> let s' = assoc key s in search_aux (fn arg::l::acc) s' in search_aux [decompose t default] s0 let sub_search t s = let absorbant = function Next(k,_,s') -> is_absorbant k | _ -> false in let cdr = function Next(_,Up(Up(s)),_) -> s | _ -> assert false in let rec sub_search_aux res acc s = match acc with | [] -> (match s with Root v -> v::res | _ -> res) | ([]::acc) -> (try let s' = assoc_up s in fun () -> sub_search_aux res acc s' with Not_found -> fun () -> res) () | (l::acc) when absorbant s -> sub_search_aux res acc (cdr s) | ((`C(key,fn,arg)::l)::acc) -> let res = (try let s' = assoc key s in fun () -> sub_search_aux res (fn arg::l::acc) s' with Not_found -> fun () -> res) () in if is_flexible key then sub_search_aux res (l::acc) s else res | _ -> assert false (* wrong incomplete match from OCaml ?*) in sub_search_aux [] [decompose t default] s let iter f s = let rec g = function Empty -> () | Root v -> f v | Up s -> g s | Next(_,s,s') -> g s; g s' in g s let fold f s a = let rec g a = function Empty -> a | Root v -> f v a | Up s -> g a s | Next(_,s,s') -> g (g a s) s' in g a s let rec collect_all res = function | Empty -> res | Root v -> v::res | Up s -> collect_all res s | Next(k,s,s') -> collect_all (collect_all res s) s' let search_sub t s0 = let rec skip_sub_tree fn acc depth s = if depth = 0 then fn acc s else match s with Up(s) -> skip_sub_tree fn acc (depth - 1) s | Next(k,s,s') -> skip_sub_tree fn (skip_sub_tree fn acc (depth + 1) s) depth s' | _ -> acc in let rec skip_sub_tree' fn acc k ls = match ls with Next(key,s,s') -> let acc = if (match k with Some k -> cmp_key key k < 0 | None -> true) && is_flexible key then skip_sub_tree fn acc 1 s else acc in skip_sub_tree' fn acc k s' | _ -> acc in let rec search' res acc s = match acc with | [] -> collect_all res s | ([]::acc') -> let res = (try let s' = assoc_up s in fun () -> search' res acc' s' with Not_found -> fun () -> res) () in skip_sub_tree' (fun res s -> search' res acc s) res None s | ([`C(key,fn,arg)]::acc') when is_absorbant key -> assert ((fn arg) = []); skip_sub_tree (fun res s -> search' res acc s) res 1 s | ((`C(key,fn,arg)::l)::acc') -> let res = (try let s' = assoc key s in fun () -> search' res (fn arg::l::acc') s' with Not_found -> fun () -> res) () in skip_sub_tree' (fun res s -> search' res acc s) res (Some key) s in let rec search_sub_aux res acc s = let res = search' res acc s in let rec fn res s = match s with Next(k,s,s') -> fn (search_sub_aux res acc s) s' | Up(s) -> fn res s | _ -> res in fn res s in search_sub_aux [] [decompose t default] s0 let mkUp s = match s with Empty -> Empty | _ -> Up(s) let mkNext k s s' = match s, s' with Empty, Empty -> Empty | Empty, _ -> s' | _ -> Next(k,s,s') let rec replace_up v l = match l with Up _ -> mkUp v | Next(k,s,l) -> mkNext k s (replace_up v l) | _ -> assert false let rec replace key v l = match l with | Next(k,_,l) when cmp_key k key = 0 -> mkNext k v l | Next(k,s,l) when cmp_key k key < 0 -> mkNext k s (replace key v l) | _ -> assert false let remove_search_sub (t:tree) s0 = let rec skip_sub_tree fn acc depth s = if depth = 0 then fn acc s else match s with Up(s) -> let ns, res = skip_sub_tree fn acc (depth - 1) s in mkUp(ns), res | Next(k,s,s') -> let ns, res = skip_sub_tree fn acc (depth + 1) s in let ns', res = skip_sub_tree fn res depth s' in mkNext k ns ns', res | _ -> s, acc in let rec skip_sub_tree' fn acc k ls = match ls with Next(key,s,s') -> let ns, acc = if (match k with Some k -> cmp_key key k < 0 | None -> true) && is_flexible key then skip_sub_tree fn acc 1 s else s, acc in let ns', acc = skip_sub_tree' fn acc k s' in mkNext key ns ns', acc | _ -> ls, acc in let rec search' res acc ls = match acc with | [] -> Empty, collect_all res ls | ([]::acc') -> let ls, res = (try let s' = assoc_up ls in fun () -> let ns, res = search' res acc' s' in replace_up ns ls, res with Not_found -> fun () -> ls,res) () in skip_sub_tree' (fun res s -> search' res acc s) res None ls | ([`C(key,fn,arg)]::acc') when is_absorbant key -> assert ((fn arg) = []); skip_sub_tree (fun res s -> search' res acc' s) res 1 ls | ((`C(key,fn,arg)::l)::acc') -> let ls, res = (try let s' = assoc key ls in fun () -> let ns, res = search' res (fn arg::l::acc') s' in replace key ns ls, res with Not_found -> fun () -> ls,res) () in let ls, res = skip_sub_tree' (fun res s -> search' res acc s) res (Some key) ls in ls, res in let rec search_sub_aux res t s = let ns, res = search' res t s in let rec fn res s = match s with Next(k,s,s') -> let ns, res = search_sub_aux res t s in let ns', res = fn res s' in mkNext k ns ns', res | Up(s) -> let ns, res = fn res s in mkUp ns, res | _ -> s, res in fn res ns in search_sub_aux [] [decompose t default] s0 end : Map with type tree = T.tree) --------------010200060404030305010802--