Ptree

A module for the planar tree data type, defined by

type 'a ptree = Empty | Node of 'a * ('a ptree list)

This data type is useful for representing hierachical structures such as website layouts, directory structures or graphical user interfaces (GUIs).

module type PTREE = 
  sig
    (* The type of planar trees containing elements of type 'a *)
    type 'a t

    exception Empty_tree (* raised when fold is applied to the empty tree *)

    (* Create returns an empty planar tree *)
    val create: unit -> 'a t

    (* Insert e e0 tree inserts element e as the child of element e0 in the
       tree and returns the new tree *)
    val insert : 'a -> 'a -> 'a t -> 'a t

    (* Delete e tree removes element e (and its children) from the tree and
       returns the new tree *)    
    val delete : 'a -> 'a t -> 'a t

    (* Fold is the reduce function for the planar tree type *)
    val fold : ('a -> 'b list -> 'b) -> 'a t -> 'b

    (* Map f applies the function f to each element of the tree and returns
       the new tree *)
    val map : ('a -> 'b) -> 'a t -> 'b t

    (* Iter f applies f to each element of the tree, returns unit *)
    val iter : ('a -> 'b) -> 'a t -> unit

    (* is_empty returns true if the tree is empty *)
    val is_empty : 'a t -> bool

    (* Test for membership of the tree *)
    val mem : 'a -> 'a t -> bool

    (* Size of tree, i.e. number of elements *)
    val size : 'a t -> int

    (* Height of tree *)
    val height : 'a t -> int 

    (* Paths from root node to all other nodes *)
    val paths : 'a t -> 'a list list

    (* Convert a list of (parent,child) to a tree *)
    val of_list : ('a * 'a) list -> 'a t
  end;;

module Ptree : PTREE =
  struct

    (* \section{Higher order functions}  *) 
    (* Some useful higher order functions: *)

    (* [compose] : function composition *)
    let compose f g x = f(g x);;

    (* [id] : (identity) acts as the base element for function composition
          eg if recursively folding compose over a list of functions
             identity is the base element (c.f. 0, []). *)
    let id x = x;;

    (* [complement] : given two lists a and b returns the list of elements
                        in b and not a (this may be the opposite to the normal 
                        definition of complement - check this!) *)
    let complement alst blst = List.fold_right
      (fun e acc->if not(List.mem e alst) then e::acc else acc) 
      blst [];;

    (* [unique] : Union of a single list, removing repeated entries *)
    let rec unique = function 
      | [] -> []
      | x :: xs -> [x] @ (unique (List.filter (fun y->y<>x) xs));;

    (* \section{Planar Tree Data Type} *)

    (* A planar tree consists of nodes of tuples of an element of 
       type $\alpha$ and a list of sub planar trees.  Leaf nodes 
       have the empty list as their list of sub trees. *) 
    type 'a t = Empty | Node of 'a * ('a t list);;

    exception Empty_tree;;
    exception Not_found;;

    (* \subsection{Planar Tree functions} *)

    (* \subsubsection{Insertion and Deletion} *)

    (* [create] : create an empty tree *)
    let create () = Empty;;

    (* [insert] : function to insert an element into a tree as the leaf of 
       an existing node or leaf.   The idea is to first see if the parent node 
       Node(e0,lst) exists in the tree, and if so then add the new node to 
       the list of subtrees of that node *)
    let rec insert e0 e = function
      | Empty -> Node(e,[])
      | (Node(a,lst) as t) -> 
          if a=e0 then Node(a,lst @ [Node(e,[])])
                  else match lst with 
                    | [] -> t
                    | x :: xs -> Node(a,List.map (fun y->insert e0 e y) lst);;

    (* [filterNonEmpty] : remove any [Empty] trees from lists of subtrees *)
    let filterNonEmpty lst = List.filter (fun x->x <> Empty) lst;;

    (* [delete] : function to remove a node (and any subnodes) from a tree.
       *)
    let rec delete e = function 
      | Empty -> Empty
      | (Node(a,lst) as t) -> 
          if a=e then Empty 
             else match lst with
               | [] -> t
               | x::xs -> Node(a,filterNonEmpty 
                                     (List.map (fun y->delete e y) lst)
                                   );; 

    (* [is_empty] : test to see if the tree is empty *)
    let is_empty = function Empty -> true | _ -> false;;

    (* \subsubsection{Map and Fold} *)

    (* [fold]: Fold function for trees. *)
    let rec fold f = function Empty -> raise Empty_tree 
      | Node(a,lst) -> f a (List.map (fold f) lst);; 

    (* [map]: apply a function to each element of a tree. *)
    let map f = fold (fun x lst -> Node(f x, lst));;

    (* [iter] : applies function f to all elements of a tree *)
    let rec iter f t = match t with
      | Empty -> ()
      | Node(a,lst) -> f a; List.iter (fun x-> iter f x) lst;;

    (* [mem] : test for membership of a tree *)
    let mem e t = fold (fun x lst->List.fold_left ( || ) x lst) 
                       (map (fun x-> x=e) t);;

    (* [size] : number of elements in the tree *)
    let size t = fold (fun x lst -> 1 + (List.fold_left ( + ) 0 lst)) t;;

    let rec down n = function Empty -> Empty 
      | Node(x,lst) -> Node(n, List.map (down (n+1)) lst);;

    let depths t = down 1 t;;

    (* [height] : maximum distance from root node to leaf. *)
    let rec height = function Empty -> 0
      | Node(x,lst) -> 1 + List.fold_left max 0 (List.map height lst);; 

    (* [paths] : list of all paths from root node to other nodes in tree *)
    let paths t = fold 
      (fun x lst -> match lst with
      | [] -> [ [x] ]
      | y :: ys -> List.fold_left ( @ ) [[x]]
                   (List.map (fun a -> List.map (fun b-> x :: b) a) lst) ) t;; 

    (* Rather than constructing a tree from an explicit series of insert
       operations, it is easier to construct the tree by folding over a
       list of (parent node, child node) tuples.  The first element of the
       list is a bit special as the parent node value is not used by the
       insert funstion. *)

    let of_list ndlst = match ndlst with
    |  [] -> Empty
    |  x :: xs -> 
      let root = fst x in
      List.fold_left (fun acc (e0,e)->insert e0 e acc) (Node(root,[])) xs;; 
  end;;