Pretty Print Tree Data Structures in Common Lisp

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
}

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

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

Hi Vsevolod, Thanks for the link. Very nice post!. I also like your Lisp blog. I’ve put a number of your posts on my reading list. In your post you state: _“I, in fact, was always interested in creative ways of text-based visualization.”_ Then, maybe you find this interesting too: svgbob<https://ivanceras.github.io/md/Svgbob.md>. This tool transforms ASCII art into svg images. At first glance a hilarious idea, but I found that this is sometimes quite handy. The GitHub project is here: https://github.com/ivanceras/svgbob Peter

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

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