1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;;                                                                     ;;;
3;;;                     Carnegie Mellon University                      ;;;
4;;;                  and Alan W Black and Kevin Lenzo                   ;;;
5;;;                      Copyright (c) 1998-2000                        ;;;
6;;;                        All Rights Reserved.                         ;;;
7;;;                                                                     ;;;
8;;; Permission is hereby granted, free of charge, to use and distribute ;;;
9;;; this software and its documentation without restriction, including  ;;;
10;;; without limitation the rights to use, copy, modify, merge, publish, ;;;
11;;; distribute, sublicense, and/or sell copies of this work, and to     ;;;
12;;; permit persons to whom this work is furnished to do so, subject to  ;;;
13;;; the following conditions:                                           ;;;
14;;;  1. The code must retain the above copyright notice, this list of   ;;;
15;;;     conditions and the following disclaimer.                        ;;;
16;;;  2. Any modifications must be clearly marked as such.               ;;;
17;;;  3. Original authors' names are not deleted.                        ;;;
18;;;  4. The authors' names are not used to endorse or promote products  ;;;
19;;;     derived from this software without specific prior written       ;;;
20;;;     permission.                                                     ;;;
21;;;                                                                     ;;;
22;;; CARNEGIE MELLON UNIVERSITY AND THE CONTRIBUTORS TO THIS WORK        ;;;
23;;; DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING     ;;;
24;;; ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT  ;;;
25;;; SHALL CARNEGIE MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE     ;;;
26;;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   ;;;
27;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN  ;;;
28;;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,         ;;;
29;;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF      ;;;
30;;; THIS SOFTWARE.                                                      ;;;
31;;;                                                                     ;;;
32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33;;;
34;;;  log and/or zscore duration
35;;;
36
37(set! seg_dur_info (load "festival/dur/etc/durs.meanstd" t))
38
39(define (zscore_log_dur seg)
40  (let ((di (assoc (item.name seg) seg_dur_info)))
41    (cond
42     ((not di)
43      (format stderr "zscore_log_dur: %s no info found\n"
44	      (item.name seg))
45      (/ (- (log 0.100)
46	    (car (cdr di)))
47	 (car (cdr (cdr di))))      )
48     (t
49      (/ (- (log (item.feat seg "segment_duration"))
50	    (car (cdr di)))
51	 (car (cdr (cdr di))))))))
52
53(define (zscore_dur seg)
54  (let ((di (assoc_string (item.name seg) seg_dur_info)))
55    (cond
56     ((not di)
57      (format stderr "zscore_dur: %s no info found\n"
58	      (item.name seg))
59      (/ (- 0.100
60	    (car (cdr di)))
61	 (car (cdr (cdr di))))      )
62     (t
63      (/ (- (item.feat seg "segment_duration")
64	    (car (cdr di)))
65	 (car (cdr (cdr di))))))))
66
67
68
69(define (onset_has_ctype seg type)
70  ;; "1" if onset contains ctype
71  (let ((syl (item.relation.parent seg 'SylStructure)))
72    (if (not syl)
73	"0" ;; a silence
74	(let ((segs (item.relation.daughters syl 'SylStructure))
75	      (v "0"))
76	  (while (and segs
77		      (not (string-equal
78			    "+"
79			    (item.feat (car segs) "ph_vc"))))
80		 (if (string-equal
81		      type
82		      (item.feat (car segs) "ph_ctype"))
83		     (set! v "1"))
84		 (set! segs (cdr segs)))
85	  v))))
86
87(define (coda_has_ctype seg type)
88  ;; "1" if coda contains ctype
89  (let ((syl (item.relation.parent seg 'SylStructure)))
90    (if (not syl)
91	"0" ;; a silence
92	(let ((segs (reverse (item.relation.daughters
93			      syl 'SylStructure)))
94	      (v "0"))
95	  (while (and segs
96		      (not (string-equal
97			    "+"
98			    (item.feat (car segs) "ph_vc"))))
99		 (if (string-equal
100		      type
101		      (item.feat (car segs) "ph_ctype"))
102		     (set! v "1"))
103		 (set! segs (cdr segs)))
104	  v))))
105
106(define (onset_stop seg)
107  (onset_has_ctype seg "s"))
108(define (onset_fric seg)
109  (onset_has_ctype seg "f"))
110(define (onset_nasal seg)
111  (onset_has_ctype seg "n"))
112(define (onset_glide seg)
113  (let ((l (onset_has_ctype seg "l")))
114    (if (string-equal l "0")
115	(onset_has_ctype seg "r")
116	"1")))
117
118(define (coda_stop seg)
119  (coda_has_ctype seg "s"))
120(define (coda_fric seg)
121  (coda_has_ctype seg "f"))
122(define (coda_nasal seg)
123  (coda_has_ctype seg "n"))
124(define (coda_glide seg)
125  (let ((l (coda_has_ctype seg "l")))
126    (if (string-equal l "0")
127	(coda_has_ctype seg "r")
128	"1")))
129