generic-library/festival
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
festival/lib/tobi_rules.scm

1003 lines
35 KiB
Scheme
Raw Permalink Blame History

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;
;;; Centre for Speech Technology Research ;;
;;; University of Edinburgh, UK ;;
;;; Copyright (c) 1996,1997 ;;
;;; All Rights Reserved. ;;
;;; ;;
;;; Permission is hereby granted, free of charge, to use and distribute ;;
;;; this software and its documentation without restriction, including ;;
;;; without limitation the rights to use, copy, modify, merge, publish, ;;
;;; distribute, sublicense, and/or sell copies of this work, and to ;;
;;; permit persons to whom this work is furnished to do so, subject to ;;
;;; the following conditions: ;;
;;; 1. The code must retain the above copyright notice, this list of ;;
;;; conditions and the following disclaimer. ;;
;;; 2. Any modifications must be clearly marked as such. ;;
;;; 3. Original authors' names are not deleted. ;;
;;; 4. The authors' names are not used to endorse or promote products ;;
;;; derived from this software without specific prior written ;;
;;; permission. ;;
;;; ;;
;;; THE UNIVERSITY OF EDINBURGH AND THE CONTRIBUTORS TO THIS WORK ;;
;;; DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ;;
;;; ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT ;;
;;; SHALL THE UNIVERSITY OF EDINBURGH NOR THE CONTRIBUTORS BE LIABLE ;;
;;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES ;;
;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN ;;
;;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ;;
;;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF ;;
;;; THIS SOFTWARE. ;;
;;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Authors: Robert A. J. Clark and Alan W Black
;;; Modifications and Checking:
;;; Gregor Moehler (moehler@ims.uni-stuttgart.de)
;;; Matthew Stone (mdstone@cs.rutgers.edu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Generate F0 points from tobi labels using rules given in:
;;; Jilka, Moehler & Dogil (forthcomming in Speech Communications)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; *** Converted to new Relation architecture -- but not checked yet -- awb
;;; -> crude (beta) checking: gm in Dec. 98
;;;
;;; -> fixed TAKEOVER bug that used time value
;;; as pitch target (!) - MDS 1/02
;;; -> hacked around bunches of target overlap problems - MDS 1/02
;;; -> added primitive pitch range controls
;;;
;;; Known problems and bugs:
;;; Can't currently use voicing intervals which cross syllable boundaries,
;;; so pre/post-nuclear tones are currently places 0.2s before/after the
;;; nuclear tone even if no voicing occurs. Failing this they default a
;;; percentage of the voicing for that syllable.
;;;
;;; Don't know about target points ahead of the current syllable.
;;; (As you need to know what comes before them to calculate them)
;;; So: post accent tones are placed 0.2 ahead if following syllable exists
;;; ends before 0.2 from starred target and is not accented
;;; The H-target of the H+!H* is 0.2 sec instead of 0.15 sec before
;;; starred tone.
;;;
;;; Multi-utterance input has not been tested.
;;;
;;; !H- does not generate any targets
;;;
;;; Unfortunaltely some other modules may decide to put pauses in the
;;; middle of a phrase
;;;
;;; valleys are not tested yet
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; To use this in a voice
;;; (require 'tobi_rules)
;;; And in the voice call
;;; (setup_tobi_f0_method)
;;; Set the following for your speaker's F0 range
;;; (Parameter.set 'Default_Topline 146)
;;; (Parameter.set 'Default_Start_Baseline 61)
;;; (Parameter.set 'Valley_Dip 75)
;; level of debug printout
(set! printdebug 0)
(define (setup_tobi_f0_method)
"(setup_tobi_f0_method)
Set up parameters for current voice to use the implementaion
of ToBI labels to F0 targets by rule."
(Parameter.set 'Int_Method Intonation_Tree)
(Parameter.set 'Int_Target_Method Int_Targets_General)
(set! int_accent_cart_tree no_int_cart_tree) ; NONE always
(set! int_tone_cart_tree no_int_cart_tree) ; NONE always
(set! int_general_params
(list
(list 'targ_func tobi_f0_targets))) ; we will return a list of f0 targets here
(Parameter.set 'Phrase_Method 'cart_tree)
(set! phrase_cart_tree tobi_label_phrase_cart_tree) ; redefines the phrasebreak tree
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;
;;;;;; Define and set the new f0 rules
;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Set global parameters
;;; You may want to reset these for different speakers
(Parameter.set 'Default_Topline 146) ;146
(Parameter.set 'Default_Start_Baseline 61) ;61
(Parameter.set 'Current_Topline (Parameter.get 'Default_Topline))
(Parameter.set 'Current_Start_Baseline (Parameter.get 'Default_Start_Baseline))
(Parameter.set 'Current_End_Baseline (Parameter.get 'Current_Start_Baseline))
(Parameter.set 'Downstep_Factor 0.70)
(Parameter.set 'Valley_Dip 75)
;;; function to add target points on a given syllable and fill in
;;; targets where necessary
(define (tobi_f0_targets utt syl)
"(tobi_f0_targets UTT ITEM)
Returns a list of targets for the given syllable."
(if (and (>= printdebug 1)
(not(equal? 0 (item.feat syl "R:Intonation.daughter1.name"))))
(format t "### %l (%.2f %.2f) %l ptarg: %l ###\n" (item.name syl)
(item.feat syl "syllable_start")(item.feat syl "syllable_end")
(item.feat syl "R:Intonation.daughter1.name") (ttt_last_target_time syl)))
;; only continue if there is a Word related to this syllable
;; I know there always should be, but there might be a bug elsewhere
(cond
((not(equal? 0 (item.feat syl "R:SylStructure.parent.name")))
; get current label. This assumes that there is only one accent and
; one endtone on a syllable. Although there can be one of each.
(let ((voicing (ttt_get_voice_times syl)) ; voicing interval
(pvoicing (ttt_get_voice_times ; previous voicing
(item.relation.prev syl 'Syllable)))
(nvoicing (ttt_get_voice_times ; next voicing
(item.relation.next syl 'Syllable))))
; if first syl of phrase set Phrase_Start and Phrase_End parameters
; and reset downstep (currently does so on big and little breaks.)
; only assignes Default values at this stage
; maybe trained from CART later - first steps now - MDS
; following Moehler and Mayer, SSW 2001
(if (eq 0 (item.feat syl 'syl_in)) ;; GM maybe something better needed here?
(progn
(Parameter.set 'Phrase_Start (item.feat syl 'R:SylStructure.parent.R:Phrase.last.word_start))
(Parameter.set 'Phrase_End (item.feat syl 'R:SylStructure.parent.R:Phrase.last.word_end))
(Parameter.set 'Current_Topline
(/ (* (wagon syl ttt_topline_tree)
(Parameter.get 'Default_Topline)) 100))
(Parameter.set 'Current_Start_Baseline
(/ (* (wagon syl ttt_baseline_tree)
(Parameter.get 'Default_Start_Baseline)) 100))
(Parameter.set 'Current_End_Baseline
(Parameter.get 'Current_Start_Baseline))
(if (>= printdebug 3)
(begin
(print (format nil "new range: %f %f %f"
(Parameter.get 'Current_Topline)
(Parameter.get 'Current_Start_Baseline)
(Parameter.get 'Current_End_Baseline) )))) ))
; do stuff (should go only if there is an accent/boundary?)
(let ((new_targets
(ttt_to_targets syl (wagon syl ttt_starttone_tree)
voicing
pvoicing
nvoicing
'Starttones)))
(set! new_targets (append new_targets
(ttt_to_targets syl (wagon syl ttt_accent_tree)
voicing
pvoicing
nvoicing
'Accents)))
(set! new_targets (append new_targets
(ttt_to_targets syl (wagon syl ttt_endtone_tree)
voicing
pvoicing
nvoicing
'Endtones)))
(if (and(not(equal? new_targets nil))
(>= printdebug 2))
(begin
(format t ">> Targets: %l\n" new_targets)
(format t ">> LastTarget: %l\n" (last new_targets))
))
new_targets)))))
;;; CART tree to specify no accents
(set! no_int_cart_tree
'
((NONE)))
;;;
;;; Relate phrasing to boundary tones.
;;; Added downstepped tones - MDS
(set! tobi_label_phrase_cart_tree
'
((tone in ("L-" "H-" "!H-"))
((B))
((tone in ("H-H%" "H-L%" "!H-L%" "L-L%" "L-H%"))
((BB))
((NB)))))
;;;
;;; The other functions
;;;
;;; process a list of relative targets and convert to actual targets
(define (ttt_to_targets syl rlist voicing pvoicing nvoicing type)
"Takes a list of target sets and returns a list of targets."
(if (or (and (>= printdebug 2)
rlist (atom (caar rlist))
(not (equal? 'NONE (caar rlist))) (not (equal? '(NONE) (caar rlist))))
(>= printdebug 3))
(begin (print "Entering ttt_to_targets with:")
(print (format nil "rlist: %l vc: %l pvc: %l nvc: %l type: %s" rlist voicing pvoicing nvoicing type))))
(cond
;; nowt
((eq (length rlist) 0) ())
;; a single target set
((atom (car (car rlist)))
(cond
((eq type 'Accents)
(ttt_accent_set_to_targets syl rlist voicing pvoicing nvoicing))
((eq type 'Starttones)
(ttt_bound_set_to_targets syl rlist voicing pvoicing))
((eq type 'Endtones)
(ttt_bound_set_to_targets syl rlist voicing pvoicing))
(t (error "unknown target set encountered in ttt_to_targets"))))
;; list of target sets
((atom (car (car (car rlist))))
(append (ttt_to_targets syl (cdr rlist) voicing pvoicing nvoicing type)
(ttt_to_targets syl (car rlist) voicing pvoicing nvoicing type)))
;; error
(t (error "something strange has happened in ttt_to_targets"))))
;; process a starttone/endtone target set.
(define (ttt_bound_set_to_targets syl tset voicing pvoicing)
"takes a start/endtone target set and returns a list of target points."
(if (>= printdebug 3) (begin
(print "Entering ttt_bound_set_to_targets with:")
(pprintf (format nil "tset: %l vc: %l pvc: %l" tset voicing pvoicing))))
(cond
;; usually target given is NONE. (also ignore unknown!)
((or (eq (car (car tset)) 'NONE)
(eq (car (car tset)) 'UNKNOWN))
nil)
;; a pair of target pairs
((eq (length tset) 2)
(list (ttt_get_target (car tset) voicing)
(ttt_get_target (car (cdr tset)) voicing)))
;; single target pair
((eq (length tset) 1)
(cond
;; an actual target pair
((not (null (cdr (car tset))))
(list (ttt_get_target (car tset) voicing)))
;; a TAKEOVER marker
((eq (car (car tset)) 'TAKEOVER)
(list (list (ttt_interval_percent voicing 0)
(ttt_last_target_value syl))))
(t (error "unknown target pair in ttt_bound_set_to_targets"))))
(t (error "unknown target set type in ttt_bound_set_to_targets"))))
;; process an accent target set.
(define (ttt_accent_set_to_targets syl tset voicing pvoicing nvoicing)
"takes a accent target set and returns a list of target points."
(if (>= printdebug 3) (begin
(print "Entering ttt_accent_set_to_targets with:")
(pprintf (format nil "tset: %l vc: %l pvc: %l nvc: %l" tset voicing pvoicing nvoicing))))
(cond
;; single target in set
((null (cdr tset))
(cond
; target given is NONE.
((or (eq (car (car tset)) 'NONE)
(eq (car (car tset)) 'UNKNOWN)) nil)
; V1 marker
((eq (car (car tset)) 'V1)
(let ((target_time (+ (/ (- (next_accent_start syl)
(ttt_last_target_time syl))
2.0)
(ttt_last_target_time syl))))
(list (list target_time (ttt_accent_pitch (Parameter.get 'Valley_Dip) target_time)))))
; V2 marker
((eq (car (car tset)) 'V2)
(let ((target_time (+ (ttt_last_target_time syl) 0.25)))
(list (list target_time (ttt_accent_pitch (Parameter.get 'Valley_Dip) target_time)))))
; V3 marker
((eq (car (car tset)) 'V3)
(let ((target_time (- (next_accent_start syl) 0.25)))
(list (list target_time (ttt_accent_pitch (Parameter.get 'Valley_Dip) target_time)))))
; single target pair
(t (list (ttt_get_target (car tset) voicing)))))
;; a pair of targets
((length tset 2)
(cond
;; a *ed tone with PRE type tone (as in L+H*)
((eq (car (car tset)) 'PRE)
(let ((star_target (ttt_get_target (car (cdr tset)) voicing))
(last_target (parse-number(ttt_last_target_time syl))))
(cond
; normal 0.2s case (currently doesn't check for voicing)
((and (eqv? 0 (ip_initial syl))
(> (- (car star_target) 0.2) last_target))
(list (list (- (car star_target) 0.2)
(ttt_accent_pitch (car (cdr (car tset)))
(- (car star_target) 0.2))) ; the time
star_target))
; 90% prev voiced if not before last target - Added back in MDS,
; with parse-number added and new check for ip_initial
((and (eqv? 0 (ip_initial syl))
(> (parse-number (ttt_interval_percent pvoicing 90))
(parse-number (ttt_last_target_time syl))))
(list (list (ttt_interval_percent pvoicing 90)
(ttt_accent_pitch (car (cdr (car tset)))
(ttt_interval_percent pvoicing 90)))
star_target))
; otherwise (UNTESTED) [NOTE: Voicing for this syllable only]
(t
(list (list (ttt_interval_percent voicing 20)
(ttt_accent_pitch (car (cdr (car tset)))
(ttt_interval_percent voicing 20)))
star_target)))))
; a *ed tone with POST type tone (as L*+H)
((eq (car(car(cdr tset))) 'POST)
(let ((star_target (ttt_get_target (car tset) voicing))
(next_target nil ) ; interesting problem
(next_syl (item.next syl)))
(cond
; normal 0.2s case (UNTESTED)
((and (not (equal? next_syl nil))
(eq 0 (item.feat next_syl "accented")))
(cond
((< (+ (car star_target) 0.2) (item.feat next_syl "syllable_end"))
(list star_target
(list (+ (car star_target) 0.2)
(ttt_accent_pitch (car (cdr (car (cdr tset))))
(+ (car star_target) 0.2) ))))
(t
(list star_target
(list (ttt_interval_percent nvoicing 90)
(ttt_accent_pitch (car (cdr (car (cdr tset))))
(ttt_interval_percent nvoicing 90) ))))))
; 20% next voiced (BUG: Can't do this as the next target hasn't been
; calculated yet!)
(nil nil)
;otherwise (UNTESTED)
(t (list star_target
(list (ttt_interval_percent voicing 90)
(ttt_accent_pitch (car (cdr (car (cdr tset))))
(ttt_interval_percent voicing 90) )))))))
(t
;; This case didn't use to happen, but now must
;; to avoid +H's clobbering endtones - MDS's hack.
(list (ttt_get_target (car tset) voicing)
(ttt_get_target (cadr tset) voicing)))))
;; something else...
(t (error (format nil "unknown accent set in ttt_accent_set_to_targets: %l" tset)))))
(define (ttt_get_target pair voicing)
"Returns actual target pair, usually for a stared tone."
(if (>= printdebug 4) (begin
(print "Entering ttt_get_target with:")
(pprintf pair) (pprintf voicing)))
(list (ttt_interval_percent voicing (car pair))
(ttt_accent_pitch (car (cdr pair))
(ttt_interval_percent voicing (car pair)))))
(define (ttt_accent_pitch value time)
"Converts a accent pitch entry to a pitch value."
(if (>= printdebug 4) (begin
(print "Entering ttt_accent_pitch with:")
(pprintf value)))
(cond
;; a real value
((number? value)
(ttt_interval_percent (list (ttt_get_current_baseline time)
(Parameter.get 'Current_Topline))
value))
;; Downstep then Topline
((eq value 'DHIGH)
(progn
(Parameter.set 'Current_Topline (+ (ttt_get_current_baseline time)
(* (Parameter.get 'Downstep_Factor)
(- (Parameter.get 'Current_Topline)
(ttt_get_current_baseline time)))))
(ttt_interval_percent (list (ttt_get_current_baseline time)
(Parameter.get 'Current_Topline))
100)))
;; Unknown
(t (error "Unknown accent pitch value encountered"))))
(define (ttt_get_current_baseline v)
"Returns the current declined baseline at time v."
(if (>= printdebug 4) (begin
(print "Entering ttt_get_current_baseline with:")
(pprintf v)))
(let ((h (Parameter.get 'Current_Start_Baseline))
(l (Parameter.get 'Current_End_Baseline))
(e (Parameter.get 'Phrase_End))
(s (Parameter.get 'Phrase_Start)))
(- h (* (/ (- h l) (- e s)) (- v s)))))
;;; find the time n% through an inteval
(define (ttt_interval_percent pair percent)
"Returns the time that is percent percent thought the pair."
(if (>= printdebug 4) (begin
(print "Entering ttt_interval_percent with:")
(pprintf (format nil "%l, %l" pair percent))))
(cond
; no pair given: just return nil
((null pair) nil)
; otherwise do the calculation
(t (let ((start (car pair))
(end (car(cdr pair))))
(+ start (* (- end start) (/ percent 100)))))))
;;; Getting start and end voicing times in a syllable
(define (ttt_get_voice_times syl_item)
"Returns a pair of start time of first voiced phone in syllable and
end of last voiced phone in syllable, or nil if syllable is nil"
(cond
((null syl_item) nil)
(t (let ((segs (item.relation.daughters syl_item "SylStructure")))
(list
(item.feat (ttt_first_voiced segs) "segment_start")
(item.feat (ttt_first_voiced (reverse segs)) "end"))))))
(define (ttt_first_voiced segs)
"Returns first segment that is voiced (vowel or voiced consonant)
returns last segment if all are unvoiced."
(cond
((null (cdr segs))
(car segs)) ;; last possibility
((equal? "+" (item.feat (car segs) "ph_vc"))
(car segs))
((equal? "+" (item.feat (car segs) "ph_cvox"))
(car segs))
(t
(ttt_first_voiced (cdr segs)))))
;;; ttt_last_target has bifurcated into
;;; ttt_last_target_time and
;;; ttt_last_target_value
;;; to fix a place where f0 was set to last target time!
;;; - MDS
(define (ttt_last_target_time syl)
"Returns the end of the most recent previous target
in the utterance or nil if there is not one present
"
(if (>= printdebug 3)
(begin (print "Entering ttt_last_target_time")
(print syl))
)
(let ((target (ttt_last_target syl)))
(if (null? target)
nil
(item.feat target "R:Target.daughter1.pos"))))
(define (ttt_last_target_value syl)
"Returns the pitch of the most recent previous target
in the utterance or nil if there is not one present
"
(if (>= printdebug 3)
(begin (print "Entering ttt_last_target_time")
(print syl))
)
(let ((target (ttt_last_target syl)))
(if (null? target)
nil
(item.feat target "R:Target.daughter1.f0"))))
;; Changed to scan through segments in the segment relation,
;; to catch (notional) targets on pauses. - MDS
;;
;;; associated segments are:
;;; - the segments in the word
;;; - subsequent segments not in the syllable structure
;;; and on the first word, preceding segments
;;; not in the syllable structure
(define (ttt_collect_following seg accum)
(if (or (null? seg)
(not (null? (item.relation seg 'SylStructure))))
accum
(ttt_collect_following (item.next seg)
(cons seg accum))))
(define (ttt_last_target syl)
"Returns the most recent previous target
in the utterance or nil if there is not one present
"
(if (>= printdebug 3)
(begin (print "Entering ttt_last_target")
(print syl))
)
(let ((prev_syl (item.relation.prev syl 'Syllable)))
(cond
; ((symbol-bound? 'new_targets) (last (caar new_targets)))
((null prev_syl) nil)
((ttt_last_target_segs
(ttt_collect_following
(item.relation.next
(item.relation.daughtern prev_syl "SylStructure")
"Segment")
(reverse (item.relation.daughters prev_syl "SylStructure")))))
;list of segments of prev. syllable
;in reverse order, with pauses
;prepended.
(t (ttt_last_target prev_syl)))))
(define (ttt_last_target_segs segs)
"Returns the first target no earlier than seg
or nil if there is not one
"
(if (>= printdebug 4)
(begin (print "Entering ttt_last_target_segs with:")
(pprintf (format nil "%l" segs))
))
(cond
((null segs) nil)
((and (> (parse-number
(item.feat (car segs) "R:Target.daughter1.f0")) 0)
(eq 0 (item.feat (car segs) "R:SylStructure.parent.lisp_lh_condition"))
(eq 0 (item.feat (car segs) "R:SylStructure.parent.lisp_hl_condition"))
(eq 0 (item.feat (car segs) "R:SylStructure.parent.lisp_valley_condition")))
(car segs))
(t (ttt_last_target_segs (cdr segs)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;
;;;;;; CART TREES (ttt - tobi to target)
;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Return a list of target lists. A target list comprises of a list
;;; of related targets (ie for the L and H in L+H*), just to confuse
;;; matters each target is also a list! (pos pitch)
;;;
(set! ttt_endtone_tree ; BUG: does it check the current syl for last accent?
'
((tobi_endtone is NONE) ; ususally none
((((NONE))))
((tobi_endtone is "H-H%") ; H-H%
((((100 120))))
((tobi_endtone is "L-L%") ; L-L%
((((100 -20))))
((tobi_endtone is "L-H%") ; L-H%
((lisp_last_accent > 2)
((lisp_last_accent_type is "L*")
((((0 25) (100 40)))) ; paper says 80 but AWB had 40
((((0 0) (100 40)))))
((lisp_last_accent_type is "L*")
((((100 40))))
((((50 0) (100 40))))))
((tobi_endtone is "H-L%") ; H-L%
((lisp_last_accent_type is "L*")
((tobi_accent is"L*")
((((50 100) (100 100))))
((((0 100) (100 100)))))
((((100 100)))))
((tobi_endtone is "!H-L%") ; !H-L%
((lisp_last_accent_type is "L*")
((tobi_accent is"L*")
((((50 DHIGH) (100 100))))
((((0 DHIGH) (100 100)))))
((((100 DHIGH)))))
((tobi_endtone is "H-")
((((100 100))))
((tobi_endtone is "!H-")
((((100 DHIGH))))
((tobi_endtone is "L-")
((((100 0))))
((((UNKNOWN))))))))))))))
(set! ttt_starttone_tree
'
((lisp_ip_initial = 1)
((tobi_endtone is "%H")
((((0 100))))
((p.tobi_endtone in ("H-" "!H-" "L-"))
((((TAKEOVER)))) ; takeover case
((tobi_accent is NONE)
((lisp_next_accent > 2) ; default cases (dep. on whether next target is low)
((lisp_next_accent_type in ("L*" "L*+H" "L*+!H" "L+H*" "L+!H*" "L-" "L-H%" "L-L%"))
((((0 50)(100 25))))
((((0 50)(100 75)))))
((lisp_next_accent_type in ("L*" "L*+H" "L*+!H" "L+H*" "L+!H*" "L-" "L-H%" "L-L%"))
((((0 30))))
((((0 70))))))
((tobi_accent in ("L*" "L*+H" "L*+!H" "L+H*" "L+!H*" "L-" "L-H%" "L-L%"))
((((0 30))))
((((0 70))))))))
((((NONE)))))) ; otherwise (and usually) nothing.
;; Redone after Jilka, Moehler and Dogil
;; - But treating one-syllable-ip's like
;; last-syllable-of-ip's in cases of
;; two tone switches per syllable (e.g. H* L-H%).
;; - And (hack) a 70% target for the initial
;; H*'s of phrases when the next accent is L+H*
;; - MDS
(set! ttt_accent_tree
'
((tobi_accent is "H*" ) ; H*
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((50 100))))
((((25 100)))))
((lisp_hstar_weak_target = 1)
((((60 70))))
((lisp_ip_initial = 1)
((((85 100))))
((((60 100)))))))
((tobi_accent is "!H*" ) ; !H*
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((50 DHIGH))))
((((25 DHIGH)))))
((lisp_ip_initial = 1)
((((85 DHIGH))))
((((60 DHIGH))))))
((tobi_accent is "L*" ) ; L*
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((50 0))))
((((25 0)))))
((lisp_ip_initial = 1)
((((85 0))))
((((60 0))))))
((tobi_accent is "L+H*") ; L+H*
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((PRE 20) (50 100)))) ; JMD estimated 70
((((PRE 20) (25 100)))))
((lisp_ip_initial = 1)
((((PRE 20) (90 100))))
((((PRE 20) (75 100))))))
((tobi_accent is "L+!H*") ; L+!H*
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((PRE 20) (70 DHIGH))))
((((PRE 20) (25 DHIGH)))))
((lisp_ip_initial = 1)
((((PRE 20) (90 DHIGH))))
((((PRE 20) (75 DHIGH))))))
((tobi_accent is "L*+H") ; L*+H
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((35 0) (80 100)))) ; POST would clobber endtones
((((15 0) (40 100))))) ; POST would clobber endtones - MDS
((lisp_ip_initial = 1)
((((55 0) (POST 100))))
((((40 0) (POST 100))))))
((tobi_accent is "L*+!H") ; L*+!H
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((35 0) (80 DHIGH)))) ; POST would clobber endtones - MDS
((((15 0) (40 DHIGH))))) ; POST would clobber endtones - MDS
((lisp_ip_initial = 1)
((((55 0) (POST DHIGH))))
((((40 0) (POST DHIGH))))))
((tobi_accent is "H+!H*") ; H+!H*
((lisp_ip_final = 1)
((lisp_ip_one_syllable_case = 1)
((((PRE 143) (60 DHIGH)))) ; the 143 is a hack to level out the downstep
((((PRE 143) (20 DHIGH)))))
((lisp_ip_initial = 1)
((((PRE 143) (90 DHIGH))))
((((PRE 143) (60 DHIGH))))))
((lisp_lh_condition = 1)
((((100 75))))
((lisp_lh_condition = 2)
((((0 90))))
((lisp_hl_condition = 1)
((((100 25))))
((lisp_valley_condition = 1)
((((V1 85))))
((lisp_valley_condition = 2)
((((V2 70))))
((lisp_valley_condition = 3)
((((V3 70))))
((tobi_accent is NONE) ; usually we find no accent
((((NONE))))
((((UNKNOWN)))))))))))))))))))) ; UNKNOWN TARGET FOUND
;;; Cart tree to "predict" pitch range
;;; Right now just accesses a feature
;;; "register" following Moehler & Mayer 2001.
;;; Register must be one of
;;; H - primary high register (default): 133% lowest, 92% highest
;;; H-H - expanded high register: 134% lowest, 100% highest
;;; H-L - lowered high register: 128% lowest, 87% highest
;;; L - primary low register: 100% lowest, 73% highest
;;; L-L and HL-L - low compressed: 100% lowest, 66% highest
;;; HL - expanded register: 100% lowest, 84% highest
;;; HL-H - complete register: 100% lowest, 96% highest
;;; For their speaker, ,BASELINE was 42% of PEAK
(set! ttt_topline_tree
'
((R:SylStructure.parent.register is "H")
(92)
((R:SylStructure.parent.register is "H-H")
(100)
((R:SylStructure.parent.register is "H-L")
(87)
((R:SylStructure.parent.register is "L")
(73)
((R:SylStructure.parent.register is "L-L")
(66)
((R:SylStructure.parent.register is "HL")
(84)
((R:SylStructure.parent.register is "HL-H")
(96)
(92)))))))))
(set! ttt_baseline_tree
'
((R:SylStructure.parent.register is "H")
(133)
((R:SylStructure.parent.register is "H-H")
(134)
((R:SylStructure.parent.register is "H-L")
(128)
((R:SylStructure.parent.register is "L")
(100)
((R:SylStructure.parent.register is "L-L")
(100)
((R:SylStructure.parent.register is "HL")
(100)
((R:SylStructure.parent.register is "HL-H")
(100)
(133)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;
;;;;;; Lisp Feature functions.
;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (valley_condition syl)
"(valley_condition syl)
Function to determine if a lowered target between two high target points
is needed in this syllable.
Returns: 0 - no target required
1 - the single target case
2 - the first of the two target case
3 - the second of the two target case
"
(if (>= printdebug 4)
(begin (print "Entering valley_condition")))
(cond
((and (eq 0 (item.feat syl 'accented))
(string-matches (next_accent_type syl)
"\\(H\\*\\|H\\-\\|H\\-L\\%\\|H\\-H\\%\\|\\!H\\*\\|\\!H\\-\\|\\!H\\-L\\%\\|\\!H\\-H\\%\\)")
(string-matches (last_accent_type syl)
"\\(H\\*\\|L\\+H\\*\\|L\\*\\+H\\\\|\\!H\\*\\|L\\+\\!H\\*\\|L\\*\\+\\!H\\)"))
;GM: excluded %H (returns nil for last target)
(let ((nas (next_accent_start syl))
(syls (item.feat syl 'syllable_start))
(syle (item.feat syl 'syllable_end))
(las (ttt_last_target_time syl)))
(if (>= printdebug 3)
(begin (print (format nil "nas: %l syls: %l syle %l las %l" nas syls syle las))))
(cond
((and (< (- nas las) 0.5)
(> (- nas las) 0.25)
(< syls (+ (/ (- nas las) 2.0) (ttt_last_target_time syl)))
(> syle (+ (/ (- nas las) 2.0) (ttt_last_target_time syl)))) 1)
((and (> (- nas las) 0.5)
(< syls (+ (ttt_last_target_time syl) 0.25))
(> syle (+ (ttt_last_target_time syl) 0.25))) 2)
((and (> (- nas las) 0.5)
(< syls (- nas 0.25))
(> syle (- nas 0.25))) 3)
(t 0))))
(t 0)))
(define (lh_condition syl)
"(lh_condition syl)
Function to determine the need for extra target points between an L and an H
Returns: 1 - first extra target required
2 - second extra target required
0 - no target required.
"
(if (>= printdebug 4)
(begin (print "Entering LH_condition")))
(cond
((and (eq 0 (item.feat syl 'accented))
(string-matches (last_accent_type syl) "\\(L\\*\\)")
(string-matches (next_accent_type syl)
"\\(H\\*\\|H\\-\\|H\\-L\\%\\|H\\-H\\%\\)"))
(cond
((and (eq 1 (last_accent syl))
(< 2 (next_accent syl))) 1)
((and (< 2 (last_accent syl))
(eq 1 (next_accent syl))) 2)
(t 0)))
(t 0)))
(define (hl_condition syl)
"(lh_condition syl)
Function to determine the need for extra target points between an H and an L
Returns: 1 - extra target required
0 - no target required.
"
(if (>= printdebug 4)
(begin (print "Entering HL_condition")))
(cond
((and (eq 0 (item.feat syl 'accented))
(string-matches (next_accent_type syl)
"\\(L\\*\\|L\\+H\\*\\|L\\+\\!H\\*\\|L\\*\\+H\\|L\\*\\+!H\\|L\\-\\|L\\-L\\%\\|L-H\\%\\)")
(string-matches (last_accent_type syl)
"\\(H\\*\\|L\\+H\\*\\|L\\*\\+H\\\\|\\!H\\*\\|L\\+\\!H\\*\\|L\\*\\+\\!H\\|\\%H\\)")
;MDS: added !H's
(eq 1 (last_accent syl))
;; fall faster! -MDS
(<= 2 (next_accent syl))) 1)
(t 0)))
(define (next_accent syl)
"(next_accent syl)
Wrapper for c++ func ff_next_accent.
Returns the number of the syllables to the next accent in the following format.
0 - no next accent
1 - next syllable
2 - next next syllable
etc..."
(if (>= printdebug 4)
(begin (print "Entering next_accent")))
(cond
((eq 0 (next_accent_type syl)) 0)
(t (+ (item.feat syl 'next_accent) 1))))
;; Fixed bug that crashed complex phrase tones. - MDS
;; Not sure how else to get a big number...
(define infinity (/ 1 0))
;; Modified to include current accent as well -MDS
(define (last_accent syl)
"(last_accent syl)
Wrapper for c++ func ff_last_accent.
Returns the number of the syllables to the previous accent in the following format.
0 - accent on current syllable
1 - prev syllable
2 - prev to prev syllable
etc...
infinity - no previous syllable"
(if (>= printdebug 4)
(begin (print "Entering last_accent")))
(cond
((not (equal? "NONE" (item.feat syl 'tobi_accent))) 0)
((equal? 0 (last_accent_type syl)) infinity)
(t (+ (item.feat syl 'last_accent) 1))))
(define (next_accent_type syl)
"(next_accent_type syl)
Returns the type of the next accent."
(cond
((not (eq 0 (item.feat syl "n.R:Intonation.daughter1.name")))
(item.feat syl "n.R:Intonation.daughter1.name"))
((eq 0 (item.feat syl 'syl_out)) 0) ;;GM real ip_final would be better
(t (next_accent_type (item.relation.next syl 'Syllable)))))
(define (last_accent_type syl)
"(last_accent_type syl)
Returns the type of the last (previous) accent."
(if (>= printdebug 4)
(begin (print "Entering last_accent_type")))
(cond
((not (equal? "NONE" (item.feat syl 'p.tobi_endtone)))
(item.feat syl 'R:Syllable.p.tobi_endtone))
((not (equal? "NONE" (item.feat syl 'p.tobi_accent)))
(item.feat syl 'R:Syllable.p.tobi_accent))
((eq 0 (item.feat syl 'syl_in)) 0) ;;GM real ip_initial would be better
(t (last_accent_type (item.prev syl 'Syllable)))))
(define (next_accent_start syl)
"(next_accent_start syl)
Returns the start time of the vowel of next accented syllable"
(if (>= printdebug 4)
(begin (print "Entering next_accent_start")))
(cond
((not (eq 0 (item.feat syl "n.R:Intonation.daughter1.name")))
(item.feat syl "R:Syllable.n.syllable_start")) ;;GM vowel start would be better
((eq 0 (item.feat syl 'syl_out)) 0)
(t (next_accent_start (item.relation.next syl 'Syllable)))))
; new features (not used yet)
(define (ip_final syl)
"(ip_final SYL)
returns 1 if the syllable is the final syllable of an
ip (intermediate phrase)"
(cond
((or (equal? 0 (item.feat syl "syl_out"))
(equal? "L-" (item.feat syl "tobi_endtone"))
(equal? "H-" (item.feat syl "tobi_endtone"))
(equal? "!H-" (item.feat syl "tobi_endtone"))) 1)
(t 0)))
(define (ip_initial syl)
"(ip_initial SYL)
returns 1 if the syllable is the initial syllable of an
ip (intermediate phrase)"
(cond
((equal? 0 (item.feat syl "syl_in"))
1)
((equal? 1 (ip_final (item.relation.prev syl 'Syllable)))
1)
(t 0)))
;; NEXT TWO FUNCTIONS ARE NEW - MDS
(define (ip_one_syllable_case syl)
"(ip_one_syllable_case SYL)
returns true if the syllable is the initial syllable of an
ip (intermediate phrase) and doesn't itself contain a complex
tone that starts opposite this syllable's accent"
(if (eqv? 0 (ip_initial syl))
0
(let ((accent (item.feat syl "tobi_accent"))
(tone (item.feat syl "tobi_endtone")))
(cond
((and (equal? tone "L-H%")
(or (equal? accent "H*")
(equal? accent "!H*")
(equal? accent "L+H*")
(equal? accent "L+!H*")
(equal? accent "L*+H")
(equal? accent "L*+!H*")
(equal? accent "H+!H*")))
0)
((and (or (equal? tone "H-L%")
(equal? tone "!H-L%"))
(equal? accent "L*"))
0)
(t
1)))))
(define (hstar_weak_target syl)
(if (and (equal? 0 (item.feat syl 'asyl_in))
(member (next_accent_type syl)
(list "L*" "L*+H" "L*+!H" "L+H*" "L+!H*")))
1
0))
(provide 'tobi_rules)
Reference in New Issue View Git Blame Copy Permalink