Tree with multiple parametric type variables

Learning
1

I am trying to code a tree type with nodes containing different types of value and functions to map to different formats while keeping the structure of the tree. Below is an example with three types and function to convert the tree with “string, int, bool” to a tree of only string.

type ('a, 'b, 'c) node =
  | StringLeaf of 'a
  | IntLeaf of 'b
  | Node of 'c * ('a, 'b, 'c) node list

let rec string_of_node = function
  | StringLeaf v -> StringLeaf v
  | IntLeaf v -> IntLeaf (string_of_int v)
  | Node (v, children) ->
      Node (string_of_bool v, List.map string_of_node children)

let string_tree =
  string_of_node (Node (true, [IntLeaf 5; StringLeaf "hello"]))

The approach works for small example, but becomes tedious when the number of parametric types and number of node types increase. Is there a better way to write this code? Thanks in advance.

2

Is there a particular reason why each leaf must must be polymorphic?

I.e. is there a reason why IntLeaf must be used to store the string instead of switching from IntLeaf to StringLeaf during conversion?

3

The approach works for small example, but becomes tedious when the number of parametric types and number of node types increase

You could factorize the data structure differently e.g.:

type 'a tree = Node of 'a * 'a tree list 

let mapTree f = 
  let rec aux (Node(x,xs)) = 
    Node(f x , List.map aux xs)
  in 
  aux

type ('a,'b,'c) choice3 = Choice1of3 of 'a 
                        | Choice2of3 of 'b 
                        | Choice3of3 of 'c


let mapChoice3 fa fb fc = function 
  | Choice1of3 a -> fa a
  | Choice2of3 b -> fb b 
  | Choice3of3 c -> fb c


type ('a,'b,'c) polytree = ('a,'b,'c) choice3 tree

let convertString (f : ('a,'b,'c) choice3 -> string) =
  mapTree f
4

You can use some metaprogramming to generate a map_node function with type ('a1 -> 'a2) -> ('b1 -> 'b2) -> ('c1 -> 'c2) -> ('a1, 'b1, 'c1) node -> ('a2, 'b2, 'c2) node. ppx_deriving.map can do that for you.

Your code becomes:

type ('a, 'b, 'c) node =
  | StringLeaf of 'a
  | IntLeaf of 'b
  | Node of 'c * ('a, 'b, 'c) node list
[@@deriving map]

let string_of_node =
  map_node
    (fun x -> x)    (* how to transform 'a *)
    string_of_int   (* how to transform 'b *)
    string_of_bool  (* how to transform 'c *)

let string_tree =
  string_of_node (Node (true, [IntLeaf 5; StringLeaf "hello"]))
5

Thanks for all the reply, I will check each suggestion more carefully later today. emillon’s suggestion looks really interesting, I will have to dig into ppx_deriving a bit more

To answer darrenldl’s question, originally I separated tree from the type of nodes and place node type in module A and B. However, this loses the information that of A.t and B.t only BoolLeaf can have children.

module A = struct
  type t =
  | StringLeaf of string
  | IntLeaf of int
  | BoolLeaf of bool
end

module B = struct
  type t =
  | StringLeaf of string
  | IntLeaf of string
  | BoolLeaf of string
end

type 'a node =
| Leaf of 'a
| Node of 'a * 'a node list

let rec map f n =
  match n with
  | Leaf x ->
      Leaf (f x)
  | Node (x, children) as node->
      Node (f x, List.map (fun y -> map f y) children)

let to_b_tree n =
  match n with
  | A.StringLeaf x -> B.StringLeaf "x"
  | A.IntLeaf x -> B.IntLeaf (string_of_int x)
  | A.BoolLeaf x -> B.BoolLeaf (string_of_bool x)

let a_tree =
    Node (A.BoolLeaf true
         ,  [Leaf (A.StringLeaf "hi")
            ;Leaf (A.IntLeaf 27)])

let b_tree = map to_b_tree a_tree