Gecko [ hubnogueira.com.br ]

Name	Size	Permission
dicts	[ DIR ]	drwxr-xr-x
etc	[ DIR ]	drwxr-xr-x
multisyn	[ DIR ]	drwxr-xr-x
voices	[ DIR ]	drwxr-xr-x
Sable.v0_2.dtd	6.3 KB	-rw-r--r--
Singing.v0_1.dtd	872 B	-rw-r--r--
alias_cmu_to_nitech.scm	1.43 KB	-rw-r--r--
apml.scm	16.97 KB	-rw-r--r--
apml_f2bf0lr.scm	25.43 KB	-rw-r--r--
apml_kaldurtreeZ.scm	35.11 KB	-rw-r--r--
cap-signalization.scm	2.6 KB	-rw-r--r--
cart_aux.scm	6.12 KB	-rw-r--r--
clunits.scm	10.27 KB	-rw-r--r--
clunits_build.scm	15.74 KB	-rw-r--r--
cmusphinx2_phones.scm	5.15 KB	-rw-r--r--
cslush.scm	3.88 KB	-rw-r--r--
cstr.scm	4.66 KB	-rw-r--r--
darpa_phones.scm	5.2 KB	-rw-r--r--
display.scm	3.73 KB	-rw-r--r--
duration.scm	7.31 KB	-rw-r--r--
email-mode.scm	4.14 KB	-rw-r--r--
engmorph.scm	5.79 KB	-rw-r--r--
engmorphsyn.scm	5.82 KB	-rw-r--r--
events.scm	12.3 KB	-rw-r--r--
f2bdurtreeZ.scm	33.35 KB	-rw-r--r--
f2bf0lr.scm	11.52 KB	-rw-r--r--
festdoc.scm	7.46 KB	-rw-r--r--
festival.el	10.84 KB	-rw-r--r--
festival.scm	23.72 KB	-rw-r--r--
festtest.scm	3.56 KB	-rw-r--r--
fileio.scm	2.8 KB	-rw-r--r--
fringe.scm	4.15 KB	-rw-r--r--
gswdurtreeZ.scm	34.55 KB	-rw-r--r--
holmes_phones.scm	5.32 KB	-rw-r--r--
hts.scm	17.37 KB	-rw-r--r--
init.scm	6.17 KB	-rw-r--r--
intonation.scm	7.74 KB	-rw-r--r--
java.scm	2.5 KB	-rw-r--r--
klatt_durs.scm	3.2 KB	-rw-r--r--
languages.scm	4.8 KB	-rw-r--r--
lexicons.scm	10.06 KB	-rw-r--r--
lts.scm	7.61 KB	-rw-r--r--
lts_build.scm	20.12 KB	-rw-r--r--
mbrola.scm	4.6 KB	-rw-r--r--
mettree.scm	3.72 KB	-rw-r--r--
module_description.scm	4.45 KB	-rw-r--r--
mrpa_allophones.scm	4.85 KB	-rw-r--r--
mrpa_durs.scm	3.85 KB	-rw-r--r--
mrpa_phones.scm	4.79 KB	-rw-r--r--
multiwave.scm	2.5 KB	-rw-r--r--
nopauses.scm	1.33 KB	-rw-r--r--
ogimarkup-mode.scm	7.79 KB	-rw-r--r--
oo.scm	5.46 KB	-rw-r--r--
pauses.scm	8.55 KB	-rw-r--r--
phoneset.scm	5.22 KB	-rw-r--r--
phrase.scm	6.72 KB	-rw-r--r--
pos.scm	9.02 KB	-rw-r--r--
postlex.scm	21.09 KB	-rw-r--r--
prosody-param.scm	8.76 KB	-rw-r--r--
punctuation.scm	6.08 KB	-rw-r--r--
radio_phones.scm	5.37 KB	-rw-r--r--
recode.scm	1.65 KB	-rw-r--r--
sable-latin.ent	7.93 KB	-rw-r--r--
sable-mode.scm	20.73 KB	-rw-r--r--
scfg.scm	3.18 KB	-rw-r--r--
scfg_wsj_wp20.gram	15.81 KB	-rw-r--r--
sec.B.hept.ngrambin	545 B	-rw-r--r--
sec.ts20.quad.ngrambin	33.57 KB	-rw-r--r--
singing-mode.scm	16.07 KB	-rw-r--r--
siod.scm	17.54 KB	-rw-r--r--
soleml-mode.scm	12.2 KB	-rw-r--r--
speech-dispatcher.scm	7.49 KB	-rw-r--r--
speech.properties	88 B	-rw-r--r--
spell-mode.scm	1.81 KB	-rw-r--r--
ssml-mode.scm	22.52 KB	-rw-r--r--
synthesis.scm	14.48 KB	-rw-r--r--
tilt.scm	30.79 KB	-rw-r--r--
tobi.scm	22.79 KB	-rw-r--r--
tobi_rules.scm	34.61 KB	-rw-r--r--
token.scm	22.86 KB	-rw-r--r--
tokenize.scm	5.73 KB	-rw-r--r--
tokenpos.scm	9.82 KB	-rw-r--r--
tts.scm	10.92 KB	-rw-r--r--
unilex_phones.scm	7.73 KB	-rw-r--r--
util.scm	6.43 KB	-rw-r--r--
voice-select.scm	6.75 KB	-rw-r--r--
voices.scm	13.04 KB	-rw-r--r--
wave.scm	2.41 KB	-rw-r--r--
web.scm	4.13 KB	-rw-r--r--
word-mapping.scm	1.89 KB	-rw-r--r--

Code Editor : lts.scm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                       ;;
;;;                Centre for Speech Technology Research                  ;;
;;;                     University of Edinburgh, UK                       ;;
;;;                         Copyright (c) 1998                            ;;
;;;                        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.                                                       ;;
;;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Functions specific to supporting a trained LTS rules
;;;

(define (lts_rules_predict word feats)
  (let ((dcword (downcase word))
	(syls) (phones))
    (if (string-matches dcword "[a-z]*")
	(begin
	  (set! phones 
		(cdr (reverse (cdr (reverse (lts_predict dcword))))))
	  (set! phones (add_lex_stress word feats phones))
	  (set! syls (lex.syllabify.phstress phones))
;;	  (set! syls (add_lex_stress word syls))
	  )
	(set! syls nil))
    (format t "word %l phones %l\n" word syls)
    (list word nil syls)))

;(define (add_lex_stress word syls)
;  (cond
;   ((> (length syls) 1)
;      (set-car! (cdr (nth (- (length syls) 2) syls)) 1))
;   ((word-is-content word english_guess_pos)
;      (set-car! (cdr (car syls)) 1)))
;  syls)

(define (word-is-content word guess_pos)
  (cond
   ((null guess_pos)
    t)
   ((member_string word (cdr (car guess_pos)))
    nil)
   (t
    (word-is-content word (cdr guess_pos)))))

(defvar lts_pos nil)

(define (lts_predict word rules)
  "(lts_predict word rules)
Return list of phones related to word using CART trees."
  (let ((utt (make_let_utt (enworden (symbolexplode word)))))
    (predict_phones utt rules)
    (cdr (reverse (cdr (reverse ;; remove #'s
      (mapcar item.name (utt.relation.items utt 'PHONE))))))
    )
)

(define (make_let_utt letters)
"(make_let_utt letters)
Build an utterances from th4ese letters."
  (let ((utt (Utterance Text "")))
    (utt.relation.create utt 'LTS)
    (utt.relation.create utt 'LETTER)
    (utt.relation.create utt 'PHONE)
    ;; Create letter stream
    (mapcar
     (lambda (l)
       (let ((lsi (utt.relation.append utt 'LETTER)))
	 (item.set_feat lsi "pos" lts_pos)
	 (item.set_name lsi l)))
     letters)
    utt))

(define (predict_phones utt rules)
  "(predict_phones utt)
Predict phones using CART."
  (add_new_phone utt (utt.relation.first utt 'LETTER) '#)
  (mapcar
   (lambda (lsi)
     (let ((tree (car (cdr (assoc (intern (item.name lsi)) rules)))))
       (if (not tree)
	   (format t "failed to find tree for %s\n" (item.name lsi))
	   (let ((p (wagon_predict lsi tree)))
;	     (format t "predict %s %s\n" (item.name lsi) p)
	     (cond
	      ((string-matches p ".*-.*-.*-.*") ; a quad one
	       (add_new_phone utt lsi (string-before p "-"))
	       (add_new_phone utt lsi (string-before (string-after p "-") "-"))
	       (add_new_phone utt lsi (string-before (string-after (string-after p "-") "-") "-"))
	       (add_new_phone utt lsi (string-after (string-after (string-after p "-") "-") "-")))
	      ((string-matches p ".*-.*-.*") ; a triple one
	       (add_new_phone utt lsi (string-before p "-"))
	       (add_new_phone utt lsi (string-before (string-after p "-") "-"))
	       (add_new_phone utt lsi (string-after (string-after p "-") "-")))
	      ((string-matches p ".*-.*");; a double one
	       (add_new_phone utt lsi (string-before p "-"))
	       (add_new_phone utt lsi (string-after p "-")))
	      (t
	       (add_new_phone utt lsi p)))))))
   (reverse (cdr (reverse (cdr (utt.relation.items utt 'LETTER))))))
  (add_new_phone utt (utt.relation.last utt 'LETTER) '#)
  utt)

(define (add_new_phone utt lsi p)
  "(add_new_phone utt lsi p)
Add new phone linking to letter, ignoreing it if its _epsilon_."
  (if (not (equal? p '_epsilon_))
      (let ((psi (utt.relation.append utt 'PHONE)))
	(item.set_name psi p)
	(item.relation.append_daughter
	 (utt.relation.append utt 'LTS lsi)
	 'LTS psi)
	)))

(define (enworden lets)
  (cons '# (reverse (cons '# (reverse lets)))))

;;; Lexical stress assignment
;;;

(define (add_lex_stress word pos phones tree)
  "(add_lex_stress word syls)
Predict lexical stress by decision tree."
  (let ((utt (Utterance Text ""))
	(si)
	(nphones))
    (utt.relation.create utt 'Letter)
    (set! si (utt.relation.append utt 'Letter))
    (item.set_feat si 'pos pos)
    (item.set_feat si 'numsyls (count_syls phones))
    (item.set_feat si 'sylpos 1)
    (set! nphones (add_lex_stress_syl phones si tree))
;    (format t "%l\n" phones)
;    (format t "%l\n" nphones)
    nphones))

(define (count_syls phones)
  (cond
   ((null phones) 0)
   ((string-matches (car phones) "[aeiou@].*")
    (+ 1 (count_syls (cdr phones))))
   (t (count_syls (cdr phones)))))

(define (add_lex_stress_syl phones si tree)
  "(add_lex_stress_syl phones si tree)
Add lexical stressing."
  (cond
   ((null phones) nil)
   ((string-matches (car phones) "[aeiou@].*")
    (item.set_feat si 'phone (car phones))
    (item.set_feat si 'name (car phones))
    (item.set_feat si 'num2end 
			 (- (+ 1 (item.feat si 'numsyls))
			    (item.feat si 'sylpos)))
    (set! stress (wagon_predict si tree))
    (item.set_feat si 'sylpos
			 (+ 1 (item.feat si 'sylpos)))
    (cons
     (if (not (string-equal stress "0"))
	 (string-append (car phones) stress)
	 (car phones))
     (add_lex_stress_syl (cdr phones) si tree)))
   (t 
    (cons
     (car phones)
     (add_lex_stress_syl (cdr phones) si tree)))))

;;; Morphological analysis

;(define (wfst_stemmer)
;  (wfst.load 'stemmer "/home/awb/projects/morpho/engstemmer.wfst")
;  (wfst.load 'stemmerL "/home/awb/projects/morpho/engstemmerL.wfst")
;  t)

;(define (stem word)
;  (wfst.transduce 'stemmer (enworden (symbolexplode word))))

;(define (stemL word)
;  (wfst.transduce 'stemmerL (enworden (symbolexplode word))))

(provide 'lts)

${this.title}

Code Editor : lts.scm