Trees

A tree is a very common datastructure. I stumbled upon this subject because of a requirement that is needed for a mathematical solution. This solution needs to keep track of changes that start with a single change but can have multiple effects. Each effect, i.e. change, can result in turn into multiple changes, hence the need of a tree structure.

First I read the excellent post by Scott Wlaschin about trees as a recursive data structure. Then I tried to find some general purpose library dealing with tree types, however, I couldn’t find one. Only then I turned “Real Programmer” and tried to translate the code form the post to fulfill my requirements.

But first, what is a tree?

Tree with root, branches and leaves

So, a tree consists of a root with multiple branches and each branch can have multiple leaves. When we consider a root as just a special case of a branch, a tree, in fact, consists of just two types: the branch type and the leave type. In F# we can model this as:

/// Recursive tree type with tree-like semantics.
/// So the tree can just consist of a leaf or branch
/// or a branch can have multiple subtrees consisting 
/// of either leafs or branches.
/// A leaf or branch can but do not nescessarily be of
/// different types.
type GeneralTree<'Branch, 'Leaf> =
    | Empty
    | Leaf of leaf: 'Leaf
    | Branch of branch: 'Branch * trees: GeneralTree<'Branch, 'Leaf> seq 

So, a tree can be

  • Empty
  • Just a leave
  • Just a branch (with an empty sequence of trees)
  • A branch with one leave (i.e. a sequence with a ‘leave tree’)
  • A branch with multiple branches/leaves (i.e. a sequence of trees)

Note that it is easy to derive “special trees” from this general tree, like:

type BinaryTree<'Node> = 
    | Empty
    | Node of node: 'Node * left: BinaryTree<'Node> * right: BinaryTree<'Node>


type SimpleTree<'Node> = GeneralTree<'Node, 'Node>

The “simple tree” is a direct subtype of the “general tree”. The “binary tree” needs to be mapped to a “general tree”.

But first the code to handle the general tree.

[<RequireQualifiedAccess>]
module GeneralTree =


    /// Catamorphism of a tree, using:
    /// - fLeaf: that handles a leaf type and
    /// - fBranch: that handles a branch type and
    /// the recursed results of handling the subtrees.
    let cata fLeaf fBranch (tree: GeneralTree<_, _>) =
        let rec loop fLeaf fbranch tree =
            let recurse = loop fLeaf fbranch

            match tree with
            | Empty -> Empty
            | Leaf leaf -> leaf |> fLeaf
            | Branch (branch, subTrees) ->
                subTrees |> Seq.map recurse |> fbranch branch

        loop fLeaf fBranch tree


    /// A fold over a tree, using
    /// - fLeaf: that handles a leaf type and the accumulator
    /// - fBranch: that handles a branch type and the accumulator
    let fold fLeaf fBranch acc (tree: GeneralTree<_, _>) =
        let rec loop fLeaf fbranch acc tree =
            let recurse = loop fLeaf fbranch

            match tree with
            | Empty -> acc
            | Leaf leaf -> leaf |> fLeaf acc
            | Branch (branch, subTrees) ->
                let acc = branch |> fbranch acc
                subTrees |> Seq.fold recurse acc

        loop fLeaf fBranch acc tree


    /// Foldback of a tree, using:
    /// - fLeaf: that handles a leaf type and the accumulator
    /// - fBranch: that handles a branch type and the accumulator
    let foldBack fLeaf fBranch (tree: GeneralTree<_, _>) acc =
        let rec loop fLeaf fbranch tree fAcc =
            let recurse = loop fLeaf fbranch

            match tree with
            | Empty -> fAcc
            | Leaf leaf -> fun _ -> leaf |> fLeaf (fAcc ())
            | Branch (branch, subTrees) ->
                fun _ -> branch |> fBranch (fAcc ())
                |> Seq.foldBack recurse subTrees

        loop fLeaf fBranch tree (fun () -> acc)
        |> fun f -> f ()


    /// Map the leaf and branch types of a tree, using
    /// - fLeaf: to map the leaf type from a -> b and
    /// - fBranch: to map a branch from c -> d
    let map fLeaf fBranch (tree: GeneralTree<_, _>) =
        let rec loop fLeaf fBranch tree =
            let recurse = loop fLeaf fBranch

            match tree with
            | Empty -> Empty
            | Leaf leaf -> leaf |> fLeaf |> Leaf
            | Branch (branch, subTrees) ->
                (branch |> fBranch, subTrees |> Seq.map recurse)
                |> Branch

        loop fLeaf fBranch tree


    /// Iterate through a tree, using
    /// - fLeaf: to handle the leaf type and
    /// - fBranch: to handle the branch type
    let iter fLeaf fBranch (tree: GeneralTree<_, _>) =
        let rec loop fLeaf fBranch tree =
            let recurse = loop fLeaf fBranch

            match tree with
            | Empty -> ()
            | Leaf leaf -> leaf |> fLeaf
            | Branch (branch, trees) ->
                trees |> Seq.iter recurse
                branch |> fBranch

        loop fLeaf fBranch tree


    /// Map the leaf and branch types of a tree, using
    /// - fLeaf: to map the leaf type from a -> b and
    /// - fBranch: to map a branch from c -> d
    /// the map functions also get all the tree indexes:
    /// - p: a sequence of parent indexes
    /// - d: the depth of the tree item
    /// - i: the item number in the parent
    let mapi fLeaf fBranch (tree: GeneralTree<_, _>) =
        let rec loop fLeaf fBranch p d i tree =
            let recurse = loop fLeaf fBranch

            match tree with
            | Empty -> Empty
            | Leaf leaf -> leaf |> fLeaf p d i |> Leaf
            | Branch (branch, subTrees) ->
                let branch = branch |> fBranch p d i
                let p = [ i ] |> List.append p
                let d = d + 1

                (branch,
                 subTrees
                 |> Seq.mapi (fun i t -> i, t)
                 |> Seq.map (fun (i, tree) -> recurse p d i tree))
                |> Branch

        loop fLeaf fBranch [] 0 0 tree


    /// Gives an nice string representation of a tree
    /// incorperating all tree specific indexes like:
    /// - parent indexes
    /// - depth (by indentation)
    /// - breath (the count) and
    /// - the item number in the list of the parent
    let toString leafToString branchToString (tree: GeneralTree<_, _>) =
        let fLeaf p d i leaf =
            let leaf = leaf |> leafToString
            let p = p @ [ i ] |> List.map string |> String.concat "."
            let s = $"{p} %s{leaf}"
            let tabs = "\t" |> Seq.replicate d |> String.concat ""
            sprintf "%s" (tabs + s)

        let fBranch p d i branch =
            let branch = branch |> branchToString
            let p = p @ [ i ] |> List.map string |> String.concat "."
            let s = $"{p} %s{branch}"
            let tabs = "\t" |> Seq.replicate d |> String.concat ""
            sprintf "%s" (tabs + s)

        let tost acc s = $"{acc}\n{s}"

        tree |> mapi fLeaf fBranch |> fold tost tost ""


    /// Iterate through a tree, using
    /// - fLeaf: to handle the leaf type and
    /// - fBranch: to handle the branch type
    /// the handle functions also get all the tree indexes:
    /// - p: a sequence of parent indexes
    /// - d: the depth of the tree item
    /// - b: the breath of the tree item
    /// - i: the item number in the parent
    let iteri fLeaf fBranch (tree: GeneralTree<_, _>) =
        let rec loop fLeaf fBranch p d b i tree =
            let recurse = loop fLeaf fBranch

            match tree with
            | Empty -> b
            | Leaf leaf ->
                leaf |> fLeaf p b d i
                b
            | Branch (branch, trees) ->
                branch |> fBranch p b d i
                let p = [ i ] |> List.append p
                let d = d + 1

                trees
                |> Seq.mapi (fun i t -> i, t)
                |> Seq.fold (fun b (i, tree) -> recurse p d (b + 1) i tree) b

        loop fLeaf fBranch [] 0 0 0 tree |> ignore


    /// Transform a tree to a table
    let toTable (tree: GeneralTree<_, _>) =
        let tableCell c item = item |> c |> Seq.singleton

        let rec loop table tree =
            match tree with
            | Empty -> Seq.empty
            | Leaf leaf ->
                let tc = leaf |> tableCell Leaf

                if table |> Seq.isEmpty then
                    tc |> Seq.singleton
                else
                    table |> Seq.map (fun row -> tc |> Seq.append row)
            | Branch (branch, trees) ->
                if trees |> Seq.isEmpty then
                    (branch, Seq.empty)
                    |> tableCell Branch
                    |> Seq.singleton
                else
                    trees
                    |> Seq.collect (loop table)
                    |> Seq.map (fun row ->
                        let tc = (branch, Seq.empty) |> tableCell Branch
                        row |> Seq.append tc)

        loop Seq.empty tree


    /// Get all distinct branhces and leaves of a tree
    let distinct (tree: GeneralTree<_, _>) =
        let addItem c acc item =
            let item = item |> c

            if acc |> Seq.contains item then
                acc
            else
                item |> Seq.singleton |> Seq.append acc

        let fLeaf = addItem Leaf
        let fBranch = addItem (fun b -> (b, Seq.empty) |> Branch)
        fold fLeaf fBranch Seq.empty tree


    /// Detect wheter in a tree there are any cyclic
    /// tree sections
    let detectCycles (tree: GeneralTree<_, _>) =
        tree
        |> toTable
        |> Seq.fold
            (fun acc row ->
                row
                |> Seq.distinct
                |> Seq.fold
                    (fun acc t ->
                        row
                        |> Seq.fold
                            (fun (n, acc') t' ->
                                match n with
                                | _ when n = 0 && t' = t ->
                                    (1, t' |> Seq.singleton)
                                | _ when n = 1 && t' <> t ->
                                    (1, t' |> Seq.singleton |> Seq.append acc')
                                | _ when n = 1 && t' = t ->
                                    (2, t' |> Seq.singleton |> Seq.append acc')
                                | _ -> (n, acc'))
                            (0, Seq.empty)
                        |> Seq.singleton
                        |> Seq.append acc)
                    Seq.empty
                |> Seq.filter (fun (n, _) -> n = 2)
                |> Seq.map snd
                |> Seq.append acc)
            Seq.empty


    let empty = Empty


    /// Initialize a tree with a branch
    let init branch = (branch, Seq.empty) |> Branch


    /// Add an item (leaf or branch) to a branch
    let addTobranch item branch tree =
        let fBranch b tree =
            if b <> branch then
                (b, tree)
            else
                (branch, item |> Seq.singleton |> Seq.append tree)
            |> Branch

        cata Leaf fBranch tree


    /// Add a leaf to a branch
    let addLeafTobranch root leaf =
        let item = leaf |> Leaf
        addTobranch item root


    /// Add a branch to a branch
    let addBranchTobranch root branch =
        let item = branch |> init
        addTobranch item root

This is a lot of code but it enables a number of general purposes:

  • Map a tree to a different kind of tree
  • Fold a tree into a single type
  • Iterate over a tree
  • Map a tree to a table representation
  • Detect cycles in a tree
  • Add branches and leaves to a tree

From this code it is then easy to create the code for, for example, the “simple tree” where there are just nodes, i.e. there is no distinction between a leaf and a branch.

[<RequireQualifiedAccess>]
module SimpleTree =


    module Tree = GeneralTree


    /// Catamorphism of a tree, using:
    /// - fNode: that handles a node type and
    /// - the recursed results of handling the subtrees.
    let cata fNode (tree: SimpleTree<_>) : SimpleTree<_> =
        let fLeaf leaf = fNode leaf Seq.empty
        Tree.cata fLeaf fNode tree


    /// A fold over a tree, using
    /// - fNode: that handles a node type and the accumulator
    let fold fNode acc (tree: SimpleTree<_>) : SimpleTree<_> =
        Tree.fold fNode fNode acc tree


    /// Foldback of a tree, using:
    /// - fNode: that handles a node type and the accumulator
    let foldBack fNode (tree: SimpleTree<_>) acc =
        Tree.foldBack fNode fNode tree acc


    /// Map the node type of a tree, using
    /// - fNode: to map the node type from a -> b
    let map fNode (tree: SimpleTree<_>) : SimpleTree<'Node> =
        Tree.map fNode fNode tree


    /// Iterate through a tree, using
    /// - fNode: to handle the node type and
    let iter fNode (tree: SimpleTree<_>) = Tree.iter fNode fNode tree


    /// Map the node type of a tree, using
    /// - fNode: to map the node type from a -> b
    /// the map functions also get all the tree indexes:
    /// - p: a sequence of parent indexes
    /// - d: the depth of the tree item
    /// - i: the item number in the parent
    let mapi fNode (tree: SimpleTree<_>) : SimpleTree<_> =
        Tree.mapi fNode fNode tree


    /// Gives an nice string representation of a tree
    /// incorperating all tree specific indexes like:
    /// - parent indexes
    /// - depth (by indentation)
    /// - breath (the count) and
    /// - the item number in the list of the parent
    let toString nodeToString (tree: SimpleTree<_>) =
        Tree.toString nodeToString nodeToString tree


    /// Iterate through a tree, using
    /// - fNode: to handle the node type
    /// the handle functions also get all the tree indexes:
    /// - p: a sequence of parent indexes
    /// - d: the depth of the tree item
    /// - b: the breath of the tree item
    /// - i: the item number in the parent
    let iteri fNode (tree: SimpleTree<_>) = Tree.iteri fNode fNode tree


    /// Transform a tree to a table
    let toTable (tree: SimpleTree<_>) : SimpleTree<_> seq seq =
        Tree.toTable tree

    /// Get all distinct nodes of a tree
    let distinct (tree: SimpleTree<_>) : SimpleTree<_> seq = Tree.distinct tree


    /// Detect wheter in a tree there are any cyclic
    /// tree sections
    let detectCycles (tree: SimpleTree<_>) : SimpleTree<_> seq seq =
        Tree.detectCycles tree


    /// Initialize a tree with a node
    let init node : SimpleTree<_> = (node, Seq.empty) |> Branch


    /// Add a node
    let add item node (tree: SimpleTree<_>) : SimpleTree<_> =
        Tree.addBranchTobranch item node tree

As the above code shows, there is very little work needed to handle a simple tree as a subtype of a general tree. For a binary tree somewhat more work is needed. But still everything is just mapping of types and functions to the general tree type and all logic is handled by the general tree module.

[<RequireQualifiedAccess>]
module BinaryTree =

    module Tree = GeneralTree


    let empty = BinaryTree.Empty


    let node a = (a, empty, empty) |> Node

    /// Helper function to map a binary tree
    /// to a general tree
    let mapToGeneralTree (tree: BinaryTree<'Node>) : GeneralTree<'Node, 'Node> =
        let rec recurse tree =
            match tree with
            | BinaryTree.Empty -> GeneralTree.empty
            | Node (node, BinaryTree.Empty, BinaryTree.Empty) ->
                node |> GeneralTree.init
            | Node (node, left, right) ->
                node
                |> GeneralTree.init
                |> GeneralTree.addTobranch (recurse left) node
                |> GeneralTree.addTobranch (recurse right) node

        recurse tree

    /// Helper function to map a general tree to
    /// a binary tree
    let mapToBinaryTree (tree: GeneralTree<_, _>) : BinaryTree<_> =
        let rec recurse tree =
            match tree with
            | GeneralTree.Empty -> empty
            | Branch (branch, trees) when trees |> Seq.length = 0 ->
                branch |> node
            | Branch (branch, trees) when trees |> Seq.length = 2 ->
                Node(
                    branch,
                    trees |> Seq.item 0 |> recurse,
                    trees |> Seq.item 1 |> recurse
                )
            | _ -> $"{tree} is not a valid binary tree" |> failwith

        tree |> recurse


    let applyMap f fBranch tree =
        let fLeaf _ = $"not supported" |> failwith

        tree
        |> mapToGeneralTree
        |> f fLeaf fBranch
        |> mapToBinaryTree


    let applyFold f fBranch acc tree =
        let fLeaf _ = $"not supported" |> failwith

        tree |> mapToGeneralTree |> f fLeaf fBranch acc


    let applyIter f fBranch acc tree =
        let fLeaf _ = $"not supported" |> failwith

        tree |> mapToGeneralTree |> f fLeaf fBranch


    /// Catamorphism of a tree, using:
    /// - fLeaf: that handles a leaf type and
    /// - fBranch: that handles a branch type and
    /// the recursed results of handling the subtrees.
    let cata fNode (tree: BinaryTree<_>) =
        let fBranch node nodes =
            if nodes |> Seq.length <> 2 then
                $"not supported" |> failwith
            else
                fNode
                    node
                    (nodes |> Seq.item 0 |> mapToBinaryTree)
                    (nodes |> Seq.item 1 |> mapToBinaryTree)
                |> mapToGeneralTree

        tree |> applyMap Tree.cata fBranch


    /// A fold over a tree, using
    /// - fLeaf: that handles a leaf type and the accumulator
    /// - fBranch: that handles a branch type and the accumulator
    let fold fNode acc (tree: BinaryTree<_>) =
        let fBranch acc node = node |> fNode acc

        tree |> applyFold GeneralTree.fold fBranch acc


    /// Foldback of a tree, using:
    /// - fLeaf: that handles a leaf type and the accumulator
    /// - fBranch: that handles a branch type and the accumulator
    let foldBack fNode (tree: BinaryTree<_>) acc =
        let fBranch acc node = node |> fNode acc

        let foldBack fLeaf fBranch acc tree =
            GeneralTree.foldBack fLeaf fBranch tree acc

        tree |> applyFold foldBack fBranch acc


    /// Map the leaf and branch types of a tree, using
    /// - fLeaf: to map the leaf type from a -> b and
    /// - fBranch: to map a branch from c -> d
    let map fNode (tree: BinaryTree<_>) : BinaryTree<_> =
        tree |> applyMap Tree.map fNode


    /// Iterate through a tree, using
    /// - fLeaf: to handle the leaf type and
    /// - fBranch: to handle the branch type
    let iter fNode (tree: BinaryTree<_>) = tree |> applyIter Tree.iter fNode


    /// Map the leaf and branch types of a tree, using
    /// - fLeaf: to map the leaf type from a -> b and
    /// - fBranch: to map a branch from c -> d
    /// the map functions also get all the tree indexes:
    /// - p: a sequence of parent indexes
    /// - d: the depth of the tree item
    /// - i: the item number in the parent
    let mapi fNode (tree: BinaryTree<_>) : BinaryTree<_> =
        tree |> applyMap Tree.mapi fNode


    /// Gives an nice string representation of a tree
    /// incorperating all tree specific indexes like:
    /// - parent indexes
    /// - depth (by indentation)
    /// - breath (the count) and
    /// - the item number in the list of the parent
    let toString nodeToString (tree: BinaryTree<_>) =
        tree
        |> mapToGeneralTree
        |> Tree.toString nodeToString nodeToString


    /// Iterate through a tree, using
    /// - fLeaf: to handle the leaf type and
    /// - fBranch: to handle the branch type
    /// the handle functions also get all the tree indexes:
    /// - p: a sequence of parent indexes
    /// - d: the depth of the tree item
    /// - b: the breath of the tree item
    /// - i: the item number in the parent
    let iteri fNode (tree: SimpleTree<_>) = tree |> applyIter Tree.iteri fNode


    /// Transform a tree to a table
    let toTable (tree: BinaryTree<_>) : BinaryTree<_> seq seq =
        tree
        |> mapToGeneralTree
        |> Tree.toTable
        |> Seq.map (Seq.map mapToBinaryTree)

    /// Get all distinct branhces and leaves of a tree
    let distinct (tree: BinaryTree<_>) : BinaryTree<_> seq =
        tree
        |> mapToGeneralTree
        |> Tree.distinct
        |> Seq.map mapToBinaryTree


    /// Detect wheter in a tree there are any cyclic
    /// tree sections
    let detectCycles (tree: BinaryTree<_>) : BinaryTree<_> seq seq =
        tree
        |> mapToGeneralTree
        |> Tree.detectCycles
        |> Seq.map (Seq.map mapToBinaryTree)


    /// Initialize a tree with a branch
    let init = node


    /// Add an item (leaf or branch) to a branch
    let add node origin (tree: BinaryTree<_>) : BinaryTree<_> =
        tree
        |> mapToGeneralTree
        |> Tree.addBranchTobranch node origin
        |> mapToBinaryTree

Currently, the code resides at a gist. However, it would be useful to turn this into a general purpose library. I think.

 208 total views,  1 views today

Leave a Reply

Your email address will not be published. Required fields are marked *