From 7d4e3908c294a506fdbc701bd81e1ed280748d37 Mon Sep 17 00:00:00 2001
From: Phuntsok Drak-pa <phundrak@phundrak.fr>
Date: Thu, 27 Jun 2019 12:05:54 +0100
Subject: [PATCH] initial commit

---
 .gitignore                 |   2 +
 phonetics-feature-tree.scm | 115 +++++++++++++++++++++++++++++++++++++
 2 files changed, 117 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 phonetics-feature-tree.scm

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..ed8f426
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+*.png
+phonetics-feature-tree
diff --git a/phonetics-feature-tree.scm b/phonetics-feature-tree.scm
new file mode 100644
index 0000000..3f83089
--- /dev/null
+++ b/phonetics-feature-tree.scm
@@ -0,0 +1,115 @@
+(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 (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 (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 (to-dot phon-tree)
+  (if (null? phon-tree)
+      "\n"
+      (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)
+       "}")))
+
+(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}" () ()))
+     ("{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}" () ()))))))
+
+(display (to-dot cons-tree)) (newline)