Created
April 27, 2023 10:01
-
-
Save Savelenko/31e3eddb90f3f4395e85a4f09d99f6ac to your computer and use it in GitHub Desktop.
Pretty printing trees in F# using a Mendler-style catamorphism
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
/// Non-empty trees. | |
type Tree<'a> = TreeNode of 'a * List<Tree<'a>> | |
/// Syntactic simulation of the `Tree` base functor. | |
let (|TreeNode_|) (a, ys) = (a, ys) | |
/// Regular catamorphism for `Tree`. | |
let rec cata f (TreeNode (a, ts)) = f a (ts |> List.map (cata f)) | |
/// Compute a result from a single `Tree` node while having access to a function which computes a result from a single | |
/// sub-tree. For each sub-tree an intermediate result of some (unknown) type has already been computed. | |
type Psi<'a,'r> = | |
abstract Apply<'intermediate> : ('intermediate -> 'r) -> ('a * List<'intermediate>) -> 'r | |
/// Mendler-style "catamorphism" for `Tree`. | |
let mcata (psi : Psi<'a,'r>) (tree : Tree<'a>) : 'r = | |
let rec c (TreeNode (a, ts)) = psi.Apply c (a, ts) | |
c tree | |
/// A helper function for tree construction. | |
let node a trees = TreeNode (a, trees) | |
/// A very simple example tree. | |
let tree1 = | |
node 1 [] | |
/// The main example tree. | |
let tree2 = | |
node 3 [node 1 [ node 0 []]; node 2 [node 5 [node 11 []]; node 7 [node 8 [node 10 []]]; node 12 []]; node 9 []] | |
/// Example: the sum of all integer elements of a tree. | |
let sum = { new Psi<int,int> with | |
member _.Apply nested (TreeNode_ (a, ts)) = a + List.sumBy nested ts | |
} | |
mcata sum tree2 | |
// 68 | |
/// More exciting example: pretty print a tree. Core principle: pass to each sub-tree what it needs to print before its | |
/// child nodes in addition to its own (single) indentation. | |
let printPretty = { new Psi<int,string -> unit> with | |
member _.Apply nested (TreeNode_ (a, ts)) = fun prefix -> | |
printfn "%d"a | |
let last = List.length ts | |
ts |> List.iteri (fun i t -> | |
printf (if i + 1 = last then "%s└─" else "%s├─") prefix // addition from parent + one "own" indentation | |
nested t (if i + 1 = last then prefix + " " else prefix + "│ ") | |
) | |
} | |
let prettyPrintTree tree = mcata printPretty tree "" | |
prettyPrintTree tree2 | |
(* | |
3 | |
├─1 | |
│ └─0 | |
├─2 | |
│ ├─5 | |
│ │ └─11 | |
│ ├─7 | |
│ │ └─8 | |
│ │ └─10 | |
│ └─12 | |
└─9 | |
*) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment