better function, with less noisy trees
This commit is contained in:
Phuntsok Drak-pa
parent
145a35c008
commit
2a5a085f9d
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,2 +1,4 @@
|
||||
*.png
|
||||
*.dot
|
||||
*.svg
|
||||
phonetics-feature-tree
|
||||
|
||||
@ -1,126 +1,120 @@
|
||||
(define (left-child tree)
|
||||
(cadr tree))
|
||||
(define (left-child-name tree)
|
||||
(car (left-child tree)))
|
||||
(define (right-child tree)
|
||||
(caddr tree))
|
||||
(define (right-child-name tree)
|
||||
(car (right-child tree)))
|
||||
(define (cur-name tree)
|
||||
(car tree))
|
||||
(define test-tree
|
||||
'("1"
|
||||
("1-1"
|
||||
("1-1-1"
|
||||
("1-1-1-1")
|
||||
("1-1-1-2"))
|
||||
("1-1-2"
|
||||
("1-1-2-1"
|
||||
("1-1-2-1-1")
|
||||
("1-1-2-1-2")
|
||||
("1-1-2-1-3")
|
||||
("1-1-2-1-4")))
|
||||
("1-1-3"
|
||||
("1-1-3-1"
|
||||
("1-1-3-1-1")
|
||||
("1-1-3-1-2"))))))
|
||||
|
||||
(define (to-string phon-tree node-nbr child next-nbr)
|
||||
(let ((this-name (string-append "node"
|
||||
(number->string node-nbr)))
|
||||
(child-name (string-append "node"
|
||||
(number->string next-nbr))))
|
||||
(string-append child-name
|
||||
"[label=\""
|
||||
(cur-name child)
|
||||
"\"];"
|
||||
this-name
|
||||
"--"
|
||||
child-name
|
||||
";\n"
|
||||
(to-dot-main child next-nbr))))
|
||||
(define (declare-node node-text node-generation)
|
||||
(string-append ;; "node"
|
||||
(number->string node-generation)
|
||||
"[label=\""
|
||||
node-text
|
||||
"\"];\n"))
|
||||
|
||||
(define (to-dot-main phon-tree node-nbr)
|
||||
(let* ((this-name (string-append (number->string node-nbr)
|
||||
"node")))
|
||||
(if (null? (left-child phon-tree))
|
||||
""
|
||||
(let ((x (* 2 (+ 1 node-nbr)))
|
||||
(y (* 2 (+ 2 node-nbr))))
|
||||
(string-append (to-string phon-tree node-nbr
|
||||
(left-child phon-tree)
|
||||
x)
|
||||
(to-string phon-tree node-nbr
|
||||
(right-child phon-tree)
|
||||
y))))))
|
||||
(define (make-link previous-node current-node)
|
||||
(string-append ;; "node"
|
||||
(number->string previous-node)
|
||||
" -- "
|
||||
;; "node"
|
||||
(number->string current-node)
|
||||
";\n"))
|
||||
|
||||
(define (to-dot phon-tree)
|
||||
(if (null? phon-tree)
|
||||
"\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{\n"
|
||||
"node[shape=plaintext];\n"
|
||||
"graph[bgcolor=\"transparent\"];\n"
|
||||
"node1[label=\""
|
||||
(cur-name phon-tree)
|
||||
"\"];\n"
|
||||
|
||||
(to-dot-main phon-tree 1)
|
||||
"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]" () ())
|
||||
("{tense}" () ()))
|
||||
("{back}"
|
||||
("[rnd]"
|
||||
("[tense]" () ())
|
||||
("{tense}"
|
||||
("[high]" ())
|
||||
("{high}" ())))
|
||||
("{rnd}"
|
||||
("[tense]"
|
||||
("[high]" () ())
|
||||
("{high}" () ()))
|
||||
("{tense}"
|
||||
("[low]" () ())
|
||||
("{low}" () ()))))))
|
||||
(define vowel2-tree
|
||||
'("[vowel]"
|
||||
("[back]"
|
||||
("[tense]"
|
||||
("[high]" () ())
|
||||
("{high}" () ()))
|
||||
("[high]")
|
||||
("{high}"))
|
||||
("{tense}"
|
||||
("[high]" () ())
|
||||
("{high}" () ())))
|
||||
("[high]")
|
||||
("{high}")))
|
||||
("{back}"
|
||||
("[tense]"
|
||||
("[high]" () ())
|
||||
("{high}" () ()))
|
||||
("[high]")
|
||||
("{high}"))
|
||||
("{tense}"
|
||||
("[high]" () ())
|
||||
("{high}" () ())))))
|
||||
("[high]")
|
||||
("{high}")))))
|
||||
|
||||
(define cons-tree
|
||||
'("[cons]"
|
||||
("[son]"
|
||||
("[dor]"
|
||||
("[high]" () ())
|
||||
("{high}" () ()))
|
||||
("[high]")
|
||||
("{high}"))
|
||||
("{dor}"
|
||||
("[cor]" () ())
|
||||
("{cor}" () ())))
|
||||
("[cor]")
|
||||
("{cor}")))
|
||||
("{son}"
|
||||
("[dor]"
|
||||
("[voice]"
|
||||
("[high]" () ())
|
||||
("{high}" () ()))
|
||||
("[high]")
|
||||
("{high}"))
|
||||
("{voice}"
|
||||
("[high]" () ())
|
||||
("{high}" () ())))
|
||||
("[high]")
|
||||
("{high}")))
|
||||
("{dor}"
|
||||
("[voice]"
|
||||
("[cor]" () ())
|
||||
("{cor}" () ()))
|
||||
("[cor]")
|
||||
("{cor}"))
|
||||
("{voice}"
|
||||
("[cor]" () ())
|
||||
("{cor}" () ()))))))
|
||||
("[cor]")
|
||||
("{cor}"))))))
|
||||
|
||||
(define verbs
|
||||
'("[verbs]"
|
||||
("[réel]"
|
||||
("[passé]" () ())
|
||||
("{passé}" () ()))
|
||||
("[passé]")
|
||||
("{passé}"))
|
||||
("{réel}"
|
||||
("[optatif]" () ())
|
||||
("[optatif]")
|
||||
("{optatif}"
|
||||
("[passé]" () ())
|
||||
("{passé}" () ())))))
|
||||
("[passé]")
|
||||
("{passé}")))))
|
||||
|
||||
(display (to-dot verbs)) (newline)
|
||||
(display (tree-to-dot vowel-tree))
|
||||
|
||||
Reference in New Issue
Block a user