features-tree/phonetics-feature-tree.scm

(define (declare-node node-text node-generation)
  (string-append (number->string node-generation)
                 "[label=\""
                 node-text
                 "\"];"))

(define (make-link previous-node current-node)
  (string-append (number->string previous-node) " -- "
                 (number->string current-node) ";"))

(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\"];"
       (declare-node (car tree) 0)
       (tree-to-dot-helper (cdr tree) 1 0)
       "}")))

; (display (tree-to-dot vowel-tree))