* Re: [Caml-list] Tries are to sequences as ? is to trees
2008-04-26 1:20 Tries are to sequences as ? is to trees Jon Harrop
@ 2008-04-26 6:58 ` Christophe Raffalli
2008-04-26 7:36 ` Jean-Christophe Filliâtre
1 sibling, 0 replies; 3+ messages in thread
From: Christophe Raffalli @ 2008-04-26 6:58 UTC (permalink / raw)
To: Jon Harrop, OCaml
[-- Attachment #1: Type: text/plain, Size: 1139 bytes --]
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
[-- Attachment #2: search_tree.ml --]
[-- Type: text/plain, Size: 12352 bytes --]
(*======================================================================
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)
^ permalink raw reply [flat|nested] 3+ messages in thread