Pretty Print Tree Data Structures in Common Lisp

{ "cells": [ { "cell_type": "markdown", "metadata": { "toc-hr-collapsed": false }, "source": [ "# Pretty Printing Tree Data Structures in Common Lisp\n", "\n", "A tree\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", "\n", "\n", "In this Jupyter Notebook we are going to implement a small pretty printer to draw tree data structures\n", "as ASCII art, well, to be precise as unicode art." ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Objective\n", "\n", "* Trees should be rendered as 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 computational notebook.\n", "* the common-lisp-jupyter kernel by Frederic Peschanski.\n", "* Steel Bank Common Lisp (SBCL)." ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Coding Style\n", "\n", "For the most part the Google Common Lisp Style Guide 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 classX\n", "as double root. Hence we use format-treefor the superclass hierarchy, but for\n", "the subclass hierarchy we use the low level functionformat-tree-segmentsand omit\n", "the root elementX. To print the partial result of format-tree-segmentswe use the\n", "same _magic_ list format directive that is used informat-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 - Wikipedia\n", "* Tree (data structure) - Wikipedia\n", "* Google Common Lisp Style Guide" ] } ], "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 }