features-tree/features-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)
       "}")))

(define consonants
  '("consonants"
    ("[stop]"
     ("[fricative]"
      ("[voice]" ("g͡ʒ"))
      ("{voice}" ("k͡ʃ")))
     ("{fricative}"
      ("[nasal]"
       ("[clic]" ("ᵑ‖"))
       ("{clic}"
        ("[voice]"
         ("[SG]" ("n̪͡d̪ʰ"))
         ("{SG}" ("n̪͡d̪")))
        ("{voice}"
         ("[SG]" ("n̪͡t̪ʰ"))
         ("{SG}" ("n̪͡t̪")))))
      ("{nasal}"
       ("[voice]"
        ("[dorsal]"
         ("[implosive]" ("ɠ"))
         ("{implosive}"
          ("[SG]" ("gʰ"))
          ("{SG}" ("g"))))
        ("{dorsal}"
         ("[implosive]" ("ɗ̪"))
         ("{implosive}"
          ("[SG]" ("d̪ʰ"))
          ("{SG}" ("d̪")))))
       ("{voice}"
        ("[dorsal]"
         ("[implosive]" ("ƙ"))
         ("{implosive}"
          ("[SG]" ("kʰ"))
          ("{SG}" ("k"))))
        ("{dorsal}"
         ("[implosive]" ("ƭ̪"))
         ("{implosive}"
          ("[SG]" ("t̪ʰ"))
          ("{SG}" ("t̪"))))))))
    ("{stop}"
     ("[fricative]"
      ("[nasal]"
       ("[voice]" ("n͡ʒ"))
       ("{voice}" ("n͡ʃ")))
      ("{nasal}"
       ("[coronal]"
        ("[voice]" ("ʒ"))
        ("{voice}" ("ʃ")))
       ("{coronal}"
        ("[dorsal]" ("xʷ"))
        ("{dorsal}" ("ɸʷ")))))
     ("{fricative}"
      ("[cons]"
       ("[cont]" ("l̪"))
       ("{cont}"
        ("[labial]" ("m"))
        ("{labial}" ("n̪"))))
      ("{cons}"
       ("[round]" ("w"))
       ("{round}" ("j")))))))
(define vowels
  '("vowels"
    ("[low]"
     ("[nasal]" ("ɑ̃"))
     ("{nasal}" ("a")))
    ("{low}"
     ("[back]"
      ("[tense]" ("ɔ"))
      ("{tense}" ("u")))
     ("{back}"
      ("[tense]"
       ("[rnd]" ("ø"))
       ("{rnd}" ("e")))
      ("{tense}"
       ("[rnd]" ("ɛ"))
       ("{rnd}" ("œ")))))))
(display (tree-to-dot vowels))