(define (declare-node node-text node-generation) (string-append ;; "node" (number->string node-generation) "[label=\"" node-text "\"];\n")) (define (make-link previous-node current-node) (string-append ;; "node" (number->string previous-node) " -- " ;; "node" (number->string current-node) ";\n")) (define (tree-to-dot-helper tree current-generation previous-generation) ;; Helper to ~tree-to-dot~ that translates a Scheme 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 (cond ((null? tree) "") ((atom? (car tree)) ;; '("text" () () ()) (string-append (declare-node (car tree) current-generation) (make-link previous-generation current-generation) (tree-to-dot-helper (cdr tree) (+ 1 (* 10 current-generation)) current-generation))) ((list? (car tree)) ;; '(() () () ()) (string-append (tree-to-dot-helper (car tree) ;; child of current node current-generation previous-generation) (tree-to-dot-helper (cdr tree) ;; sibling of current node (+ 1 current-generation) previous-generation))))) (define (tree-to-dot tree) ;; Returns a graphviz’s dot-compatible string representing a Scheme tree (if (null? tree) "" (string-append "graph{node[shape=plaintext];graph[bgcolor=\"transparent\"];\n" (declare-node (car tree) 0) (tree-to-dot-helper (cdr tree) 1 0) "}"))) (define vowel-tree '("[vowel]" ("[back]" ("[tense]" ("[high]") ("{high}")) ("{tense}" ("[high]") ("{high}"))) ("{back}" ("[tense]" ("[high]") ("{high}")) ("{tense}" ("[high]") ("{high}"))))) (define cons-tree '("[cons]" ("[son]" ("[dor]" ("[high]") ("{high}")) ("{dor}" ("[cor]") ("{cor}"))) ("{son}" ("[dor]" ("[voice]" ("[high]") ("{high}")) ("{voice}" ("[high]") ("{high}"))) ("{dor}" ("[voice]" ("[cor]") ("{cor}")) ("{voice}" ("[cor]") ("{cor}")))))) (define verbs '("[verbs]" ("[réel]" ("[passé]") ("{passé}")) ("{réel}" ("[optatif]") ("{optatif}" ("[passé]") ("{passé}"))))) (display (tree-to-dot vowel-tree))