This repository has been archived on 2019-11-02. You can view files and clone it, but cannot push or open issues or pull requests.
features-tree/features-tree.scm

85 lines
2.7 KiB
Scheme
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(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 graphvizs 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 vowels
'("[vowel]"
("[back]"
("[tense]"
("[high]" ("ü"))
("{high}" ("ö")))
("{tense}"
("[high]" ("u"))
("{high}" ("o"))))
("{back}"
("[tense]"
("[high]" ("y"))
("{high}" ("ë")))
("{tense}"
("[high]" ("i"))
("{high}" ("e"))))))
(define syntax-tree
'("S"
("Obl")
("S'"
("NPerg"
("NP"))
("VP"
("NPdat"
("NP"))
("VP'"
("NPabs"
("NP"
("S")
("NP'"
("Adj")
("N"))))
("V'"
("Mood")
("Tense")
("V")
("Neg")))))))
(display (tree-to-dot vowels))