Tries are to sequences as ? is to trees

Tries are to sequences as ? is to trees

[Jon Harrop]

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...

-- 
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
http://www.ffconsultancy.com/products/?e

Re: [Caml-list] Tries are to sequences as ? is to trees

[Christophe Raffalli]

[-- 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)

Re: [Caml-list] Tries are to sequences as ? is to trees

[Jean-Christophe Filliâtre]

Jon Harrop a écrit :
> So tries let us associate sequences with values. What data structure lets us 
> associate trees with values?

In Okasaki's book, there is a Section 10.3.2 "Generalized Tries" which
addresses exactly this problem. The solution proposed is more efficient
than building the list of elements with fold.

-- 
Jean-Christophe Filliâtre
http://www.lri.fr/~filliatr/