Skip to content

Instantly share code, notes, and snippets.

@WetHat

WetHat/CL-PrettyPrintTrees.ipynb

Last active March 25, 2025 15:58
Show Gist options
  • Save WetHat/9682b8f70f0241c37cd5d732784d1577 to your computer and use it in GitHub Desktop.
Save WetHat/9682b8f70f0241c37cd5d732784d1577 to your computer and use it in GitHub Desktop.
Download ZIP
Pretty Print Tree Data Structures in Common Lisp
Display the source blob
Display the rendered blob
Raw
CL-PrettyPrintTrees.ipynb
{
"cells": [
{
"cell_type": "markdown",
"metadata": {
"toc-hr-collapsed": false
},
"source": [
"# Pretty Printing Tree Data Structures in Common Lisp\n",
"\n",
"A [tree](https://en.wikipedia.org/wiki/Tree_%28data_structure%29)\n",
"is a widely used abstract data type (ADT) that simulates a hierarchical tree structure, with a root value and subtrees of children with a parent node, represented as a set of linked nodes.\n",
"\n",
"![A Tree Data Structure](https://adrianmejia.com/images/tree-parts.jpg)\n",
"\n",
"In this Jupyter Notebook we are going to implement a small pretty printer to draw tree data structures\n",
"as [ASCII art](https://en.wikipedia.org/wiki/ASCII_art), well, to be precise as unicode art."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## Objective\n",
"\n",
"* Trees should be rendered as [ASCII art](https://en.wikipedia.org/wiki/ASCII_art).\n",
"* Node values of any type should be supported (as long as they can be converted to a string one way\n",
" or another)."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## About this Jupyter Notebook\n",
"\n",
"This _Gist_ was created using:\n",
"* the [Jupyter Lab](https://jupyter.org/) computational notebook.\n",
"* the [common-lisp-jupyter](https://yitzchak.github.io/common-lisp-jupyter/) kernel by Frederic Peschanski.\n",
"* [Steel Bank Common Lisp](http://www.sbcl.org/) (SBCL)."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## Coding Style\n",
"\n",
"For the most part the [Google Common Lisp Style Guide](https://google.github.io/styleguide/lispguide.xml) is used."
]
},
{
"cell_type": "markdown",
"metadata": {
"toc-hr-collapsed": false
},
"source": [
"# Pretty Printing Trees\n",
"\n",
"To draw an ASCII representation of a tree we use following approach:\n",
"* Use Unicode characters to _draw_ lines connecting the nodes of the tree.\n",
"* A tree data structure can be defined recursively as a collection of nodes (starting at a root node), where each node is a data structure consisting of a value, together with a list of references to nodes (the \"children\"), \n",
" with the constraints that no reference is duplicated. Here we define a node of the tree recursively defined as\n",
" `'(value child1 ... childN)` where:\n",
" * `value` - is the node value. an object which can be formatted as a string.\n",
" * `child1 ... childN` - child tree nodes (lists). \n",
" \n",
" E.g. the nested list `'(A (B) (C (D) (E)))` represents the tree:\n",
"\n",
" A\n",
" ├─ B\n",
" ╰─ C\n",
" ├─ D\n",
" ╰─ E\n",
"\n",
" Note: `(B)`,`'(D)`, `'(E)` are a tree nodes without children, i.e. _leaf_ nodes.\n",
"* Support custom node format functions"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## ASCII Art Node Connector Lines\n",
"\n",
"First we define a number of line drawing _glyphs_ which we ae going to use to connect the\n",
"nodes of of a tree. "
]
},
{
"cell_type": "code",
"execution_count": 1,
"metadata": {
"tags": [
"CodeExport"
]
},
"outputs": [
{
"data": {
"text/plain": [
"+SPACE+"
]
},
"execution_count": 1,
"metadata": {},
"output_type": "execute_result"
},
{
"data": {
"text/plain": [
"+UPPER-KNEE+"
]
},
"execution_count": 1,
"metadata": {},
"output_type": "execute_result"
},
{
"data": {
"text/plain": [
"+PIPE+"
]
},
"execution_count": 1,
"metadata": {},
"output_type": "execute_result"
},
{
"data": {
"text/plain": [
"+TEE+"
]
},
"execution_count": 1,
"metadata": {},
"output_type": "execute_result"
},
{
"data": {
"text/plain": [
"+LOWER-KNEE+"
]
},
"execution_count": 1,
"metadata": {},
"output_type": "execute_result"
}
],
"source": [
"; Unicode plain ASCII representation\n",
"(defconstant +space+ \" \")\n",
"(defconstant +upper-knee+ \" ╭─ \") ; \" .- \"\n",
"(defconstant +pipe+ \" │ \") ; \" | \"\n",
"(defconstant +tee+ \" ├─ \") ; \" +- \"\n",
"(defconstant +lower-knee+ \" ╰─ \") ; \" '- \""
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## format-tree-segments [Function]\n",
"\n",
"We start with a low level function which can (recursively) layout segments of a tree\n",
"as string lists.\n",
"\n",
"~~~ Lisp\n",
"(format-tree-segments (node [:layout {keyword} ]\n",
" [:node-formatter {function}])\n",
"~~~\n",
"\n",
"#### Arguments\n",
"\n",
"node {`list`}\n",
"> A node of a tree represented by nested lists.\n",
"\n",
"layout {`keyword`} default `:centered`\n",
"> Optional direction in which the tree is laid out. Supported keywords are:\n",
">\n",
"> * `:up` - layout the tree so that the root is last (root node at bottom,\n",
"> leaf nodes above root)\n",
"> * `:centered` (default) - layout the tree so that the root is at the center, half\n",
"> of the child nodes are above the root and the other half is below.\n",
"> * `:down` - layout the tree so that the root is first (root node first\n",
"> leaf nodes below root )\n",
"\n",
"node-formatter {`function`} default `#'write-to-string`\n",
"> Optional function or lambda taking the value of a tree node as the only\n",
"> parameter and returning the string representation of a tree node value.\n",
"\n",
"#### Returns\n",
"\n",
"Three values `(values upper-children root lower-children)` where:\n",
"* `upper-children` {`string list`}: ASCII art of the tree segment\n",
" which is laid out above root\n",
"* `root` {string}: Label of the root node.\n",
"* `lower-children` {`string list`}: ASCII art of the tree segment\n",
" which is laid out below root"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"tags": [
"CodeExport"
]
},
"outputs": [
{
"data": {
"text/plain": [
"FORMAT-TREE-SEGMENTS"
]
},
"execution_count": 2,
"metadata": {},
"output_type": "execute_result"
}
],
"source": [
"(defun format-tree-segments (node &key (layout :centered)\n",
" (node-formatter #'write-to-string))\n",
" (unless node\n",
" (return-from format-tree-segments nil)) ; nothing to do here\n",
" (flet ((prefix-node-strings (child-node &key layout node-formatter\n",
" (upper-connector +pipe+)\n",
" (root-connector +tee+)\n",
" (lower-connector +pipe+))\n",
" \"A local utility to add connectors to a string representation\n",
" of a tree segment to connect it to other tree segments.\"\n",
" (multiple-value-bind (u r l)\n",
" (format-tree-segments child-node\n",
" :layout layout\n",
" :node-formatter node-formatter)\n",
" ; prefix tree segment with connector glyphs to connect it to\n",
" ; other segments.\n",
" (nconc\n",
" (mapcar\n",
" (lambda (str) (concatenate 'string upper-connector str))\n",
" u)\n",
" (list (concatenate 'string root-connector r))\n",
" (mapcar\n",
" (lambda (str) (concatenate 'string lower-connector str))\n",
" l)))))\n",
" (let* ((children (rest node))\n",
" (pivot (case layout ; the split point of the list of children\n",
" (:up (length children)) ; split at top\n",
" (:down 0) ; split at bottom\n",
" (otherwise (round (/ (length children) 2))))) ; bisect\n",
" (upper-children (reverse (subseq children 0 pivot))) ; above root\n",
" (lower-children (subseq children pivot))) ; nodes below root\n",
" (values ; compile multiple value return of upper-children root lower children\n",
" (when upper-children\n",
" (loop with top = (prefix-node-strings (first upper-children)\n",
" :layout layout\n",
" :node-formatter node-formatter\n",
" :upper-connector +space+\n",
" :root-connector +upper-knee+) ; top node has special connectors\n",
" for child-node in (rest upper-children)\n",
" nconc (prefix-node-strings child-node\n",
" :layout layout\n",
" :node-formatter node-formatter)\n",
" into strlist\n",
" finally (return (nconc top strlist))))\n",
" (let ((root-name (funcall node-formatter (car node)))) ; root node\n",
" (if (= 1 (length root-name))\n",
" (concatenate 'string \" \" root-name) ; at least 2 chars needed\n",
" ;else\n",
" root-name))\n",
" (when lower-children\n",
" (loop for (head . tail) on lower-children\n",
" while tail ; omit the last child\n",
" nconc (prefix-node-strings head\n",
" :layout layout\n",
" :node-formatter node-formatter)\n",
" into strlist\n",
" finally (return\n",
" (nconc\n",
" strlist\n",
" ; bottom node has special connectors\n",
" (prefix-node-strings head\n",
" :layout layout\n",
" :node-formatter node-formatter\n",
" :root-connector +lower-knee+\n",
" :lower-connector +space+))))))))\n",
")"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## format-tree [Function]\n",
"\n",
"Producing the ASCII art is now easy. We just need to put the ASCII art for the tree segments together\n",
"and write string representation to an output stream.\n",
"\n",
"~~~ Lisp\n",
"(format-tree (node [:layout {keyword} ]\n",
" [:node-formatter {function}])\n",
"~~~\n",
"\n",
"#### Arguments\n",
"\n",
"stream {`output-stream`}\n",
"> The output stream to write the ASCII art to. If `T` the tree written\n",
"> to `*standard-output*\n",
"\n",
"root {`list of lists`}\n",
"> List of lists representing a tree\n",
"\n",
"layout {`keyword`} default `:centered`\n",
"> Optional direction in which the tree is layed out. Supported keywords are:\n",
"> * `:up` - layout the tree so that the root is last (root node at bottom,\n",
"> leaf nodes above root)\n",
"> * `:centered` (default) - layout the tree so that the root is at the center, half\n",
"> of the child nodes are above the root and the other half is below;\n",
"> * `:down` - layout the tree so that the root is first (root node first\n",
"> leaf nodes below root )\n",
"\n",
"node-formatter {`function`} default `#'write-to-string` \n",
"> Optional function or lambda taking the value of a tree node as the only\n",
"> parameter and returning the string representation of a tree node value."
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"tags": [
"CodeExport"
]
},
"outputs": [
{
"data": {
"text/plain": [
"FORMAT-TREE"
]
},
"execution_count": 3,
"metadata": {},
"output_type": "execute_result"
}
],
"source": [
"(defun format-tree (stream root &key (layout :centered)\n",
" (node-formatter #'write-to-string))\n",
" (multiple-value-bind (u r l)\n",
" (format-tree-segments root\n",
" :layout layout\n",
" :node-formatter node-formatter)\n",
" (format stream \"~{~A~%~}\" (nconc u (list r) l)))\n",
")"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Examples"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## Demonstrating the Effect of Layout Options\n",
"\n",
"To show off the different tree printing styles we a simple\n",
"tree is defined which is printed using the available layout options."
]
},
{
"cell_type": "code",
"execution_count": 4,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"NIL"
]
},
"execution_count": 4,
"metadata": {},
"output_type": "execute_result"
},
{
"name": "stdout",
"output_type": "stream",
"text": [
"Layout = :UP\n",
" ╭─ B4\n",
" │ ╭─ C2\n",
" │ ├─ C1\n",
" ├─ B3\n",
" ├─ B2\n",
" ├─ B1\n",
" A\n",
"Layout = :CENTERED\n",
" ╭─ B2\n",
" ├─ B1\n",
" A\n",
" │ ╭─ C1\n",
" ├─ B3\n",
" │ ╰─ C2\n",
" ╰─ B4\n",
"Layout = :DOWN\n",
" A\n",
" ├─ B1\n",
" ├─ B2\n",
" ├─ B3\n",
" │ ├─ C1\n",
" │ ╰─ C2\n",
" ╰─ B4\n"
]
}
],
"source": [
"(let ((tree '(A (B1) (B2) (B3 (C1) (C2)) (B4))))\n",
" ; enumerate all layout options and draw the tree for each one.\n",
" (dolist (layout '(:up :centered :down))\n",
" (format t \"Layout = :~A~%\" layout)\n",
" (format-tree t tree :layout layout)))"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## Printing a Class Hierarchy\n",
"\n",
"In this section apply tree pretty printing to a more realistic scenario, the printing of class hierarchies.\n",
"To do that we set up a simple class hierarchy and implement functions to compile superclass and subclass\n",
"hierarchies."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### A simple class hierarchy"
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"#<STANDARD-CLASS COMMON-LISP-USER::X>"
]
},
"execution_count": 5,
"metadata": {},
"output_type": "execute_result"
},
{
"data": {
"text/plain": [
"#<STANDARD-CLASS COMMON-LISP-USER::Y>"
]
},
"execution_count": 5,
"metadata": {},
"output_type": "execute_result"
},
{
"data": {
"text/plain": [
"#<STANDARD-CLASS COMMON-LISP-USER::Z>"
]
},
"execution_count": 5,
"metadata": {},
"output_type": "execute_result"
}
],
"source": [
"(defclass X ()())\n",
"(defclass Y (X)())\n",
"(defclass Z (X)())"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Compiling the superclass hierarchy\n",
"\n",
"To obtain the superclass hierarchy tree we us a straight forward recursive approach to\n",
"compile a tree represented by nested lists."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### make-superclass-tree [Function]\n",
"\n",
"Compile the superclass tree for a class.\n",
"\n",
"~~~ lisp\n",
"(make-superclass-tree class)\n",
"~~~\n",
"\n",
"#### Arguments\n",
"\n",
"class {`standard-class`}\n",
"> A class object (not a class instance!)\n",
"\n",
"#### Returns\n",
"\n",
"Superclass hierarchy tree represented as nested lists where\n",
"the class names are the values of the tree nodes."
]
},
{
"cell_type": "code",
"execution_count": 6,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"MAKE-SUPERCLASS-TREE"
]
},
"execution_count": 6,
"metadata": {},
"output_type": "execute_result"
}
],
"source": [
"(defun make-superclass-tree (class)\n",
" (when class\n",
" (cons (class-name class)\n",
" (mapcar (lambda (x) (make-superclass-tree x))\n",
" (sb-mop:class-direct-superclasses class))))\n",
")"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Pretty printing the superclass hierarchy\n",
"\n",
"Using the simple class hierachy defined earlier we can now pretty print the superclass hierarchy"
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"NIL"
]
},
"execution_count": 7,
"metadata": {},
"output_type": "execute_result"
},
{
"name": "stdout",
"output_type": "stream",
"text": [
" ╭─ T\n",
" ╭─ SB-PCL::SLOT-OBJECT\n",
" ╭─ STANDARD-OBJECT\n",
" X\n"
]
}
],
"source": [
"(format-tree t (make-superclass-tree (find-class 'X)) :layout :up )"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Compiling the subclass hierarchy\n",
"\n",
"Similar to the superclass hierarchy we here also use a straight forward recursive approach\n",
"to represent the subclass hierarchy as nested lists.\n",
"\n",
"#### Arguments\n",
"\n",
"class {`standard-class`}\n",
"> A class object (not a class instance!)\n",
"\n",
"#### Returns\n",
"\n",
"Subclass hierarchy tree represented as nested lists where\n",
"the class names are the values of the tree nodes."
]
},
{
"cell_type": "code",
"execution_count": 8,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"MAKE-SUBCLASS-TREE"
]
},
"execution_count": 8,
"metadata": {},
"output_type": "execute_result"
}
],
"source": [
"(defun make-subclass-tree (class)\n",
" (when class\n",
" (cons (class-name class)\n",
" (mapcar (lambda (x) (make-subclass-tree x))\n",
" (reverse (sb-mop:class-direct-subclasses class)))))\n",
")"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Pretty printing the subclass hierarchy\n",
"\n",
"Using the class hierarchy defined earlier we can print the subclass hierarchy too"
]
},
{
"cell_type": "code",
"execution_count": 9,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"NIL"
]
},
"execution_count": 9,
"metadata": {},
"output_type": "execute_result"
},
{
"name": "stdout",
"output_type": "stream",
"text": [
" X\n",
" ├─ Y\n",
" ╰─ Z\n"
]
}
],
"source": [
"(format-tree t (make-subclass-tree (find-class 'X)) :layout :down )"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Putting everything together\n",
"\n",
"Now, if we want to print the superclass hierarchy and in one graph we cannot simply\n",
"call `format-tree` for both the super- and subclass trees, because we would get class `X`\n",
"as double root. Hence we use `format-tree` for the superclass hierarchy, but for\n",
"the subclass hierarchy we use the low level function `format-tree-segments` and omit\n",
"the root element `X`. To print the partial result of `format-tree-segments` we use the\n",
"same _magic_ list format directive that is used in `format-tree`. Finally we supply a\n",
"formatting function which converts all values if the tree node to lowercase."
]
},
{
"cell_type": "code",
"execution_count": 10,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"NIL"
]
},
"execution_count": 10,
"metadata": {},
"output_type": "execute_result"
},
{
"name": "stdout",
"output_type": "stream",
"text": [
" ╭─ t\n",
" ╭─ sb-pcl::slot-object\n",
" ╭─ standard-object\n",
" x\n",
" ├─ y\n",
" ╰─ z\n"
]
}
],
"source": [
"(let ((class (find-class 'X))\n",
" (fmt-fnc (lambda (v) (string-downcase (write-to-string v))))) ; all nodes lowercase\n",
"\n",
" (format-tree t (make-superclass-tree class) :layout :up :node-formatter fmt-fnc)\n",
" (multiple-value-bind (u r l)\n",
" (format-tree-segments (make-subclass-tree class) :layout :down\n",
" :node-formatter fmt-fnc)\n",
" (declare (ignore u)) ; upper segment is nil anyways for layout = :down\n",
" (declare (ignore r)) ; drop the double root 'X'\n",
" (format t \"~{~A~%~}\" l))) ; just use the lower segment"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Reference\n",
"\n",
"* [ASCII art](https://en.wikipedia.org/wiki/ASCII_art) - Wikipedia\n",
"* [Tree (data structure)](https://en.wikipedia.org/wiki/Tree_%28data_structure%29) - Wikipedia\n",
"* [Google Common Lisp Style Guide](https://google.github.io/styleguide/lispguide.xml)"
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Common Lisp",
"language": "common-lisp",
"name": "common-lisp"
},
"language_info": {
"codemirror_mode": "text/x-common-lisp",
"file_extension": ".lisp",
"mimetype": "text/x-common-lisp",
"name": "common-lisp",
"pygments_lexer": "common-lisp",
"version": "1.4.14"
}
},
"nbformat": 4,
"nbformat_minor": 4
}
@lispm
Copy link

lispm commented Feb 20, 2020

That's nice! Well done!

Btw.:

  • you can get rid of the (APPLY #'NCONC ...) if you APPEND in the LOOPs, instead of COLLECT.

  • it's usually better to put a WITH clause before all the FOR clauses

  • one can also write FOR (head . tail) ON lower-children

@vseloved
Copy link

You might be interested in this post: http://lisp-univ-etc.blogspot.com/2017/04/pretty-printing-trees.html

@WetHat
Copy link
Author

WetHat commented Feb 20, 2020 via email •
edited
Loading

@WetHat
Copy link
Author

WetHat commented Feb 20, 2020

Hi lispm,

Your suggestions are very much appreciated! I'll look into them as soon as I can.

  • you can get rid of the (APPLY #'NCONC ...) if you APPEND in the LOOPs, instead of COLLECT.
  • it's usually better to put a WITH clause before all the FOR clauses
  • one can also write FOR (head . tail) ON lower-children

@vseloved
Copy link

Thanks for the pointer to svgbob. I'm collecting such references. A great list of different ASCII and similar visualization tools is crowdsourced here: https://twitter.com/SusanPotter/status/1189165775275331584

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment