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?
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
|> mapToBinaryTreeCurrently, the code resides at a gist. However, it would be useful to turn this into a general purpose library. I think.
