Simplified tree-to-dot

This commit is contained in:
Lucien Cartier-Tilet 2020-01-29 21:49:21 +01:00
parent a14464f407
commit 6f26d36bae
Signed by: phundrak
GPG Key ID: BD7789E705CB8DCA
1 changed files with 34 additions and 43 deletions

View File

@ -15,52 +15,43 @@
(defun conlanging//declare-node (node-text node-generation)
"Declares a node in the graphviz source code. The nodes identifier will be
~node-generation~, and it will bear the label ~node-text~."
(concat (number-to-string node-generation)
"[label=\""
node-text
"\"];"))
(format "%d[label=\"%s\"];\n" node-generation
node-text))
(defun conlanging//make-link (previous-node current-node)
"This creates a link in the graphviz source code between the two nodes
bearing ~previous-node~ and ~current-node~ respectively as their node
identifier."
(concat (number-to-string previous-node) " -- "
(number-to-string current-node) ";"))
(defun conlanging//tree-to-dot-helper (tree current-generation previous-generation)
"Helper to ~tree-to-dot~ that translates an Elisp tree with any number of
children per node to a corresponding graphviz file that can be executed from
dot.
(defun conlanging/tree-to-dot (tree &optional current-generation previous-generation)
"Translates an Elisp tree with any number of children per node
to a corresponding graphviz file that can be executed from dot.
Arguments:
- tree :: tree-to-convert
- current-generation :: Generation number, incremented when changing from a node
to another node from the same generation, multiplied by 10 when going from
a node to one of its children.
- previous-generation :: generation number from previous named node"
- `tree': tree to convert
- `current-generation': generation number, incremented when
changing from a node to another node from the same generation,
multiplied by 10 when going from a node to one of its children.
- `previous-generation': generation number from previous named
node"
(cond
((null tree) "")
((atom (car tree)) ;; '("text" () () ())
(concat (conlanging//declare-node (car tree) current-generation)
(conlanging//make-link previous-generation current-generation)
(conlanging//tree-to-dot-helper (cdr tree)
(+ 1 (* 10 current-generation))
current-generation)))
((listp (car tree)) ;; '(() () ())
(concat (conlanging//tree-to-dot-helper (car tree) ;; child of current node
current-generation
previous-generation)
(conlanging//tree-to-dot-helper (cdr tree)
(+ 1 current-generation)
previous-generation)))))
(defun conlanging/tree-to-dot (tree)
"Returns a graphvizs dot compatible string representing an Elisp tree"
(if (null tree) ""
(concat
"graph{graph[dpi=300];node[shape=plaintext];graph[bgcolor=\"transparent\"];"
(conlanging//declare-node (car tree) 0)
(conlanging//tree-to-dot-helper (cdr tree) 1 0)
"}")))
((null previous-generation) ;; first call
(concat "graph{graph[dpi=300];node[shape=plaintext];graph[bgcolor=\"transparent\"];\n"
(conlanging//declare-node (car tree) 0)
(conlanging/tree-to-dot (cdr tree) 1 0)
"}"))
((null tree) "") ;; last call in this branch
((atom (car tree)) ;; '("text" () () ()) manage the label
(concat (conlanging//declare-node (car tree)
current-generation)
;; make link
(concat (number-to-string previous-generation) " -- "
(number-to-string current-generation) ";\n")
(conlanging/tree-to-dot (cdr tree)
(+ 1
(* 10 current-generation))
current-generation)))
((listp (car tree)) ;; '(() () ()) manage the branches
(concat (conlanging/tree-to-dot (car tree) ;; child of current node
current-generation
previous-generation)
(conlanging/tree-to-dot (cdr tree)
(+ 1 current-generation)
previous-generation)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Common ;