But first, what is a tree?<\/p>\n\n\n\n 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:<\/p>\n\n\n\n So, a tree can be<\/p>\n\n\n\n Note that it is easy to derive “special trees” from this general tree, like:<\/p>\n\n\n\n The “simple tree” is a direct subtype of the “general tree”. The “binary tree” needs to be mapped to a “general tree”.<\/p>\n\n\n\n But first the code to handle the general tree.<\/p>\n\n\n\n This is a lot of code but it enables a number of general purposes:<\/p>\n\n\n\n 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.<\/p>\n\n\n\n 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.<\/p>\n\n\n\n Currently, the code resides at a gist<\/a>. However, it would be useful to turn this into a general purpose library. I think.<\/p>\n![\"\"](\"https:\/\/informedica.nl\/wp-content\/uploads\/2022\/07\/image.png\")
\/\/\/ Recursive tree type with tree-like semantics.\n\/\/\/ So the tree can just consist of a leaf or branch\n\/\/\/ or a branch can have multiple subtrees consisting \n\/\/\/ of either leafs or branches.\n\/\/\/ A leaf or branch can but do not nescessarily be of\n\/\/\/ different types.\ntype GeneralTree<'Branch, 'Leaf> =\n | Empty\n | Leaf of leaf: 'Leaf\n | Branch of branch: 'Branch * trees: GeneralTree<'Branch, 'Leaf> seq \n<\/code><\/pre>\n\n\n\ntype BinaryTree<'Node> = \n | Empty\n | Node of node: 'Node * left: BinaryTree<'Node> * right: BinaryTree<'Node>\n\n\ntype SimpleTree<'Node> = GeneralTree<'Node, 'Node>\n<\/code><\/pre>\n\n\n\n[<RequireQualifiedAccess>]\nmodule GeneralTree =\n\n\n \/\/\/ Catamorphism of a tree, using:\n \/\/\/ - fLeaf: that handles a leaf type and\n \/\/\/ - fBranch: that handles a branch type and\n \/\/\/ the recursed results of handling the subtrees.\n let cata fLeaf fBranch (tree: GeneralTree<_, _>) =\n let rec loop fLeaf fbranch tree =\n let recurse = loop fLeaf fbranch\n\n match tree with\n | Empty -> Empty\n | Leaf leaf -> leaf |> fLeaf\n | Branch (branch, subTrees) ->\n subTrees |> Seq.map recurse |> fbranch branch\n\n loop fLeaf fBranch tree\n\n\n \/\/\/ A fold over a tree, using\n \/\/\/ - fLeaf: that handles a leaf type and the accumulator\n \/\/\/ - fBranch: that handles a branch type and the accumulator\n let fold fLeaf fBranch acc (tree: GeneralTree<_, _>) =\n let rec loop fLeaf fbranch acc tree =\n let recurse = loop fLeaf fbranch\n\n match tree with\n | Empty -> acc\n | Leaf leaf -> leaf |> fLeaf acc\n | Branch (branch, subTrees) ->\n let acc = branch |> fbranch acc\n subTrees |> Seq.fold recurse acc\n\n loop fLeaf fBranch acc tree\n\n\n \/\/\/ Foldback of a tree, using:\n \/\/\/ - fLeaf: that handles a leaf type and the accumulator\n \/\/\/ - fBranch: that handles a branch type and the accumulator\n let foldBack fLeaf fBranch (tree: GeneralTree<_, _>) acc =\n let rec loop fLeaf fbranch tree fAcc =\n let recurse = loop fLeaf fbranch\n\n match tree with\n | Empty -> fAcc\n | Leaf leaf -> fun _ -> leaf |> fLeaf (fAcc ())\n | Branch (branch, subTrees) ->\n fun _ -> branch |> fBranch (fAcc ())\n |> Seq.foldBack recurse subTrees\n\n loop fLeaf fBranch tree (fun () -> acc)\n |> fun f -> f ()\n\n\n \/\/\/ Map the leaf and branch types of a tree, using\n \/\/\/ - fLeaf: to map the leaf type from a -> b and\n \/\/\/ - fBranch: to map a branch from c -> d\n let map fLeaf fBranch (tree: GeneralTree<_, _>) =\n let rec loop fLeaf fBranch tree =\n let recurse = loop fLeaf fBranch\n\n match tree with\n | Empty -> Empty\n | Leaf leaf -> leaf |> fLeaf |> Leaf\n | Branch (branch, subTrees) ->\n (branch |> fBranch, subTrees |> Seq.map recurse)\n |> Branch\n\n loop fLeaf fBranch tree\n\n\n \/\/\/ Iterate through a tree, using\n \/\/\/ - fLeaf: to handle the leaf type and\n \/\/\/ - fBranch: to handle the branch type\n let iter fLeaf fBranch (tree: GeneralTree<_, _>) =\n let rec loop fLeaf fBranch tree =\n let recurse = loop fLeaf fBranch\n\n match tree with\n | Empty -> ()\n | Leaf leaf -> leaf |> fLeaf\n | Branch (branch, trees) ->\n trees |> Seq.iter recurse\n branch |> fBranch\n\n loop fLeaf fBranch tree\n\n\n \/\/\/ Map the leaf and branch types of a tree, using\n \/\/\/ - fLeaf: to map the leaf type from a -> b and\n \/\/\/ - fBranch: to map a branch from c -> d\n \/\/\/ the map functions also get all the tree indexes:\n \/\/\/ - p: a sequence of parent indexes\n \/\/\/ - d: the depth of the tree item\n \/\/\/ - i: the item number in the parent\n let mapi fLeaf fBranch (tree: GeneralTree<_, _>) =\n let rec loop fLeaf fBranch p d i tree =\n let recurse = loop fLeaf fBranch\n\n match tree with\n | Empty -> Empty\n | Leaf leaf -> leaf |> fLeaf p d i |> Leaf\n | Branch (branch, subTrees) ->\n let branch = branch |> fBranch p d i\n let p = [ i ] |> List.append p\n let d = d + 1\n\n (branch,\n subTrees\n |> Seq.mapi (fun i t -> i, t)\n |> Seq.map (fun (i, tree) -> recurse p d i tree))\n |> Branch\n\n loop fLeaf fBranch [] 0 0 tree\n\n\n \/\/\/ Gives an nice string representation of a tree\n \/\/\/ incorperating all tree specific indexes like:\n \/\/\/ - parent indexes\n \/\/\/ - depth (by indentation)\n \/\/\/ - breath (the count) and\n \/\/\/ - the item number in the list of the parent\n let toString leafToString branchToString (tree: GeneralTree<_, _>) =\n let fLeaf p d i leaf =\n let leaf = leaf |> leafToString\n let p = p @ [ i ] |> List.map string |> String.concat \".\"\n let s = $\"{p} %s{leaf}\"\n let tabs = \"\\t\" |> Seq.replicate d |> String.concat \"\"\n sprintf \"%s\" (tabs + s)\n\n let fBranch p d i branch =\n let branch = branch |> branchToString\n let p = p @ [ i ] |> List.map string |> String.concat \".\"\n let s = $\"{p} %s{branch}\"\n let tabs = \"\\t\" |> Seq.replicate d |> String.concat \"\"\n sprintf \"%s\" (tabs + s)\n\n let tost acc s = $\"{acc}\\n{s}\"\n\n tree |> mapi fLeaf fBranch |> fold tost tost \"\"\n\n\n \/\/\/ Iterate through a tree, using\n \/\/\/ - fLeaf: to handle the leaf type and\n \/\/\/ - fBranch: to handle the branch type\n \/\/\/ the handle functions also get all the tree indexes:\n \/\/\/ - p: a sequence of parent indexes\n \/\/\/ - d: the depth of the tree item\n \/\/\/ - b: the breath of the tree item\n \/\/\/ - i: the item number in the parent\n let iteri fLeaf fBranch (tree: GeneralTree<_, _>) =\n let rec loop fLeaf fBranch p d b i tree =\n let recurse = loop fLeaf fBranch\n\n match tree with\n | Empty -> b\n | Leaf leaf ->\n leaf |> fLeaf p b d i\n b\n | Branch (branch, trees) ->\n branch |> fBranch p b d i\n let p = [ i ] |> List.append p\n let d = d + 1\n\n trees\n |> Seq.mapi (fun i t -> i, t)\n |> Seq.fold (fun b (i, tree) -> recurse p d (b + 1) i tree) b\n\n loop fLeaf fBranch [] 0 0 0 tree |> ignore\n\n\n \/\/\/ Transform a tree to a table\n let toTable (tree: GeneralTree<_, _>) =\n let tableCell c item = item |> c |> Seq.singleton\n\n let rec loop table tree =\n match tree with\n | Empty -> Seq.empty\n | Leaf leaf ->\n let tc = leaf |> tableCell Leaf\n\n if table |> Seq.isEmpty then\n tc |> Seq.singleton\n else\n table |> Seq.map (fun row -> tc |> Seq.append row)\n | Branch (branch, trees) ->\n if trees |> Seq.isEmpty then\n (branch, Seq.empty)\n |> tableCell Branch\n |> Seq.singleton\n else\n trees\n |> Seq.collect (loop table)\n |> Seq.map (fun row ->\n let tc = (branch, Seq.empty) |> tableCell Branch\n row |> Seq.append tc)\n\n loop Seq.empty tree\n\n\n \/\/\/ Get all distinct branhces and leaves of a tree\n let distinct (tree: GeneralTree<_, _>) =\n let addItem c acc item =\n let item = item |> c\n\n if acc |> Seq.contains item then\n acc\n else\n item |> Seq.singleton |> Seq.append acc\n\n let fLeaf = addItem Leaf\n let fBranch = addItem (fun b -> (b, Seq.empty) |> Branch)\n fold fLeaf fBranch Seq.empty tree\n\n\n \/\/\/ Detect wheter in a tree there are any cyclic\n \/\/\/ tree sections\n let detectCycles (tree: GeneralTree<_, _>) =\n tree\n |> toTable\n |> Seq.fold\n (fun acc row ->\n row\n |> Seq.distinct\n |> Seq.fold\n (fun acc t ->\n row\n |> Seq.fold\n (fun (n, acc') t' ->\n match n with\n | _ when n = 0 && t' = t ->\n (1, t' |> Seq.singleton)\n | _ when n = 1 && t' <> t ->\n (1, t' |> Seq.singleton |> Seq.append acc')\n | _ when n = 1 && t' = t ->\n (2, t' |> Seq.singleton |> Seq.append acc')\n | _ -> (n, acc'))\n (0, Seq.empty)\n |> Seq.singleton\n |> Seq.append acc)\n Seq.empty\n |> Seq.filter (fun (n, _) -> n = 2)\n |> Seq.map snd\n |> Seq.append acc)\n Seq.empty\n\n\n let empty = Empty\n\n\n \/\/\/ Initialize a tree with a branch\n let init branch = (branch, Seq.empty) |> Branch\n\n\n \/\/\/ Add an item (leaf or branch) to a branch\n let addTobranch item branch tree =\n let fBranch b tree =\n if b <> branch then\n (b, tree)\n else\n (branch, item |> Seq.singleton |> Seq.append tree)\n |> Branch\n\n cata Leaf fBranch tree\n\n\n \/\/\/ Add a leaf to a branch\n let addLeafTobranch root leaf =\n let item = leaf |> Leaf\n addTobranch item root\n\n\n \/\/\/ Add a branch to a branch\n let addBranchTobranch root branch =\n let item = branch |> init\n addTobranch item root\n\n<\/code><\/pre>\n\n\n\n[<RequireQualifiedAccess>]\nmodule SimpleTree =\n\n\n module Tree = GeneralTree\n\n\n \/\/\/ Catamorphism of a tree, using:\n \/\/\/ - fNode: that handles a node type and\n \/\/\/ - the recursed results of handling the subtrees.\n let cata fNode (tree: SimpleTree<_>) : SimpleTree<_> =\n let fLeaf leaf = fNode leaf Seq.empty\n Tree.cata fLeaf fNode tree\n\n\n \/\/\/ A fold over a tree, using\n \/\/\/ - fNode: that handles a node type and the accumulator\n let fold fNode acc (tree: SimpleTree<_>) : SimpleTree<_> =\n Tree.fold fNode fNode acc tree\n\n\n \/\/\/ Foldback of a tree, using:\n \/\/\/ - fNode: that handles a node type and the accumulator\n let foldBack fNode (tree: SimpleTree<_>) acc =\n Tree.foldBack fNode fNode tree acc\n\n\n \/\/\/ Map the node type of a tree, using\n \/\/\/ - fNode: to map the node type from a -> b\n let map fNode (tree: SimpleTree<_>) : SimpleTree<'Node> =\n Tree.map fNode fNode tree\n\n\n \/\/\/ Iterate through a tree, using\n \/\/\/ - fNode: to handle the node type and\n let iter fNode (tree: SimpleTree<_>) = Tree.iter fNode fNode tree\n\n\n \/\/\/ Map the node type of a tree, using\n \/\/\/ - fNode: to map the node type from a -> b\n \/\/\/ the map functions also get all the tree indexes:\n \/\/\/ - p: a sequence of parent indexes\n \/\/\/ - d: the depth of the tree item\n \/\/\/ - i: the item number in the parent\n let mapi fNode (tree: SimpleTree<_>) : SimpleTree<_> =\n Tree.mapi fNode fNode tree\n\n\n \/\/\/ Gives an nice string representation of a tree\n \/\/\/ incorperating all tree specific indexes like:\n \/\/\/ - parent indexes\n \/\/\/ - depth (by indentation)\n \/\/\/ - breath (the count) and\n \/\/\/ - the item number in the list of the parent\n let toString nodeToString (tree: SimpleTree<_>) =\n Tree.toString nodeToString nodeToString tree\n\n\n \/\/\/ Iterate through a tree, using\n \/\/\/ - fNode: to handle the node type\n \/\/\/ the handle functions also get all the tree indexes:\n \/\/\/ - p: a sequence of parent indexes\n \/\/\/ - d: the depth of the tree item\n \/\/\/ - b: the breath of the tree item\n \/\/\/ - i: the item number in the parent\n let iteri fNode (tree: SimpleTree<_>) = Tree.iteri fNode fNode tree\n\n\n \/\/\/ Transform a tree to a table\n let toTable (tree: SimpleTree<_>) : SimpleTree<_> seq seq =\n Tree.toTable tree\n\n \/\/\/ Get all distinct nodes of a tree\n let distinct (tree: SimpleTree<_>) : SimpleTree<_> seq = Tree.distinct tree\n\n\n \/\/\/ Detect wheter in a tree there are any cyclic\n \/\/\/ tree sections\n let detectCycles (tree: SimpleTree<_>) : SimpleTree<_> seq seq =\n Tree.detectCycles tree\n\n\n \/\/\/ Initialize a tree with a node\n let init node : SimpleTree<_> = (node, Seq.empty) |> Branch\n\n\n \/\/\/ Add a node\n let add item node (tree: SimpleTree<_>) : SimpleTree<_> =\n Tree.addBranchTobranch item node tree\n\n<\/code><\/pre>\n\n\n\n[<RequireQualifiedAccess>]\nmodule BinaryTree =\n\n module Tree = GeneralTree\n\n\n let empty = BinaryTree.Empty\n\n\n let node a = (a, empty, empty) |> Node\n\n \/\/\/ Helper function to map a binary tree\n \/\/\/ to a general tree\n let mapToGeneralTree (tree: BinaryTree<'Node>) : GeneralTree<'Node, 'Node> =\n let rec recurse tree =\n match tree with\n | BinaryTree.Empty -> GeneralTree.empty\n | Node (node, BinaryTree.Empty, BinaryTree.Empty) ->\n node |> GeneralTree.init\n | Node (node, left, right) ->\n node\n |> GeneralTree.init\n |> GeneralTree.addTobranch (recurse left) node\n |> GeneralTree.addTobranch (recurse right) node\n\n recurse tree\n\n \/\/\/ Helper function to map a general tree to\n \/\/\/ a binary tree\n let mapToBinaryTree (tree: GeneralTree<_, _>) : BinaryTree<_> =\n let rec recurse tree =\n match tree with\n | GeneralTree.Empty -> empty\n | Branch (branch, trees) when trees |> Seq.length = 0 ->\n branch |> node\n | Branch (branch, trees) when trees |> Seq.length = 2 ->\n Node(\n branch,\n trees |> Seq.item 0 |> recurse,\n trees |> Seq.item 1 |> recurse\n )\n | _ -> $\"{tree} is not a valid binary tree\" |> failwith\n\n tree |> recurse\n\n\n let applyMap f fBranch tree =\n let fLeaf _ = $\"not supported\" |> failwith\n\n tree\n |> mapToGeneralTree\n |> f fLeaf fBranch\n |> mapToBinaryTree\n\n\n let applyFold f fBranch acc tree =\n let fLeaf _ = $\"not supported\" |> failwith\n\n tree |> mapToGeneralTree |> f fLeaf fBranch acc\n\n\n let applyIter f fBranch acc tree =\n let fLeaf _ = $\"not supported\" |> failwith\n\n tree |> mapToGeneralTree |> f fLeaf fBranch\n\n\n \/\/\/ Catamorphism of a tree, using:\n \/\/\/ - fLeaf: that handles a leaf type and\n \/\/\/ - fBranch: that handles a branch type and\n \/\/\/ the recursed results of handling the subtrees.\n let cata fNode (tree: BinaryTree<_>) =\n let fBranch node nodes =\n if nodes |> Seq.length <> 2 then\n $\"not supported\" |> failwith\n else\n fNode\n node\n (nodes |> Seq.item 0 |> mapToBinaryTree)\n (nodes |> Seq.item 1 |> mapToBinaryTree)\n |> mapToGeneralTree\n\n tree |> applyMap Tree.cata fBranch\n\n\n \/\/\/ A fold over a tree, using\n \/\/\/ - fLeaf: that handles a leaf type and the accumulator\n \/\/\/ - fBranch: that handles a branch type and the accumulator\n let fold fNode acc (tree: BinaryTree<_>) =\n let fBranch acc node = node |> fNode acc\n\n tree |> applyFold GeneralTree.fold fBranch acc\n\n\n \/\/\/ Foldback of a tree, using:\n \/\/\/ - fLeaf: that handles a leaf type and the accumulator\n \/\/\/ - fBranch: that handles a branch type and the accumulator\n let foldBack fNode (tree: BinaryTree<_>) acc =\n let fBranch acc node = node |> fNode acc\n\n let foldBack fLeaf fBranch acc tree =\n GeneralTree.foldBack fLeaf fBranch tree acc\n\n tree |> applyFold foldBack fBranch acc\n\n\n \/\/\/ Map the leaf and branch types of a tree, using\n \/\/\/ - fLeaf: to map the leaf type from a -> b and\n \/\/\/ - fBranch: to map a branch from c -> d\n let map fNode (tree: BinaryTree<_>) : BinaryTree<_> =\n tree |> applyMap Tree.map fNode\n\n\n \/\/\/ Iterate through a tree, using\n \/\/\/ - fLeaf: to handle the leaf type and\n \/\/\/ - fBranch: to handle the branch type\n let iter fNode (tree: BinaryTree<_>) = tree |> applyIter Tree.iter fNode\n\n\n \/\/\/ Map the leaf and branch types of a tree, using\n \/\/\/ - fLeaf: to map the leaf type from a -> b and\n \/\/\/ - fBranch: to map a branch from c -> d\n \/\/\/ the map functions also get all the tree indexes:\n \/\/\/ - p: a sequence of parent indexes\n \/\/\/ - d: the depth of the tree item\n \/\/\/ - i: the item number in the parent\n let mapi fNode (tree: BinaryTree<_>) : BinaryTree<_> =\n tree |> applyMap Tree.mapi fNode\n\n\n \/\/\/ Gives an nice string representation of a tree\n \/\/\/ incorperating all tree specific indexes like:\n \/\/\/ - parent indexes\n \/\/\/ - depth (by indentation)\n \/\/\/ - breath (the count) and\n \/\/\/ - the item number in the list of the parent\n let toString nodeToString (tree: BinaryTree<_>) =\n tree\n |> mapToGeneralTree\n |> Tree.toString nodeToString nodeToString\n\n\n \/\/\/ Iterate through a tree, using\n \/\/\/ - fLeaf: to handle the leaf type and\n \/\/\/ - fBranch: to handle the branch type\n \/\/\/ the handle functions also get all the tree indexes:\n \/\/\/ - p: a sequence of parent indexes\n \/\/\/ - d: the depth of the tree item\n \/\/\/ - b: the breath of the tree item\n \/\/\/ - i: the item number in the parent\n let iteri fNode (tree: SimpleTree<_>) = tree |> applyIter Tree.iteri fNode\n\n\n \/\/\/ Transform a tree to a table\n let toTable (tree: BinaryTree<_>) : BinaryTree<_> seq seq =\n tree\n |> mapToGeneralTree\n |> Tree.toTable\n |> Seq.map (Seq.map mapToBinaryTree)\n\n \/\/\/ Get all distinct branhces and leaves of a tree\n let distinct (tree: BinaryTree<_>) : BinaryTree<_> seq =\n tree\n |> mapToGeneralTree\n |> Tree.distinct\n |> Seq.map mapToBinaryTree\n\n\n \/\/\/ Detect wheter in a tree there are any cyclic\n \/\/\/ tree sections\n let detectCycles (tree: BinaryTree<_>) : BinaryTree<_> seq seq =\n tree\n |> mapToGeneralTree\n |> Tree.detectCycles\n |> Seq.map (Seq.map mapToBinaryTree)\n\n\n \/\/\/ Initialize a tree with a branch\n let init = node\n\n\n \/\/\/ Add an item (leaf or branch) to a branch\n let add node origin (tree: BinaryTree<_>) : BinaryTree<_> =\n tree\n |> mapToGeneralTree\n |> Tree.addBranchTobranch node origin\n |> mapToBinaryTree<\/code><\/pre>\n\n\n\n