File: dumpfeats.sh

package info (click to toggle)
festival 1%3A2.0.95~beta-5.1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 5,448 kB
  • ctags: 4,437
  • sloc: cpp: 26,214; lisp: 14,961; ansic: 5,076; sh: 4,989; java: 1,536; makefile: 790; xml: 291; perl: 87
file content (198 lines) | stat: -rw-r--r-- 7,590 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-*-mode:scheme-*-
;;                                                                       ;;
;;                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.                                                       ;;
;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;           Author:  Alan W Black
;;;           Date:    December 1997
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Dump features from a list of utterances
;;;

;;; Because this is a --script type file it has to explicitly
;;; load the initfiles: init.scm and user's .festivalrc
(load (path-append libdir "init.scm"))

(define (dumpfeats_help)
  (format t "%s\n"
  "Usage: dumpfeats [options] <utt_file_0> <utt_file_1> ...
  Dump features from a set of utterances
  Options
  -relation <string>
             Relation from which the features have to be dumped from
  -output <string>
             If output parameter contains a %s its treated as a skeleton
             e.g feats/%s.feats and multiple files will be created one
             each utterance.  If output doesn't contain %s the output
             is treated as a single file and all features and dumped in it.
  -feats <string>
             If argument starts with a \"(\" it is treated as a list of
             features to dump, otherwise it is treated as a filename whose
             contents contain a set of features (without parenetheses).
  -eval <ifile>
             A scheme file to be loaded before dumping.  This may contain
             dump specific features etc.  If filename starts with a left
             parenthis it it evaluated as lisp.
  -from_file <ifile>
             A file with a list of utterance files names (used when there
             are a very large number of files.
")
  (quit))

;;; Default options values
(defvar utt_files nil)  ;; utterance files to dump from
(defvar desired_relation nil)
(defvar output "-")
(defvar desired_features nil)
(defvar extra-file nil)

;;; Get options
(define (get_options)
  (let ((files nil)
	(o argv))
    (if (or (member_string "-h" argv)
	    (member_string "-help" argv)
	    (member_string "--help" argv)
	    (member_string "-?" argv))
	(dumpfeats_help))
    (while o
      (begin
	(cond
	 ((string-equal "-relation" (car o))
	  (if (not (cdr o))
	      (dumpfeats_error "no stream file specified"))
	  (set! desired_relation (car (cdr o)))
	  (set! o (cdr o)))
	 ((string-equal "-output" (car o))
	  (if (not (cdr o))
	      (dumpfeats_error "no output file/skeleton specified"))
	  (set! output (car (cdr o)))
	  (set! o (cdr o)))
	 ((string-equal "-feats" (car o))
	  (if (not (cdr o))
	      (dumpfeats_error "no feats list/file specified"))
	  (if (string-matches (car (cdr o)) "^(.*")
	      (set! desired_features (read-from-string (car (cdr o))))
	      (set! desired_features (load (car (cdr o)) t)))
	  (set! o (cdr o)))
	 ((string-equal "-from_file" (car o))
	  (if (not (cdr o))
	      (durmeanstd_error "no file of utts names file specified"))
          (set! files 
                (append
                 (reverse (load (car (cdr o)) t)) files))
	  (set! o (cdr o)))
	 ((string-equal "-eval" (car o))
	  (if (not (cdr o))
	      (dumpfeats_error "no file specified to load"))
	  (if (string-matches (car (cdr o)) "^(.*")
	      (eval (read-from-string (car (cdr o))))
	      (load (car (cdr o))))
	  (set! o (cdr o)))
	 (t
	  (set! files (cons (car o) files))))
	(set! o (cdr o))))
    (if files
	(set! utt_files (reverse files)))))

(define (dumpfeats_error message)
  (format stderr "%s: %s\n" "dumpfeats" message)
  (dumpfeats_help))

;;; No gc messages
(gc-status nil)

(define (dump_all_features relname feats names outskeleton)
"(dump_all_features relname feats names outskeleton)
Dump all names features in RELNAME from utterances in NAMES
to a files or files specified by outskeleton."
  (let (fd)
    (if (not (string-matches outskeleton ".*%s.*"))
	(set! fd (fopen outskeleton "w")))
    (mapcar
     (lambda (uttfile)
       (if (cdr names)  ;; only output the utt name if there is more than one
           (format stderr "%s\n" uttfile))
       ;; change fd to new file if in skeleton mode
       (if (string-matches outskeleton ".*%s.*")
	   (set! fd (fopen (format nil outskeleton
				   (string-before 
				    (basename uttfile) "."))
			   "w")))
       (unwind-protect
        (extract_feats 
         relname 
         feats 
         (utt.load nil uttfile)
         fd)
        nil)
       (if (string-matches outskeleton ".*%s.*")
	   (fclose fd))
       t)
     names)
    (if (not (string-matches outskeleton ".*%s.*"))
	(fclose fd))))

(define (extract_feats relname feats utt outfd)
 "(extract_feats relname feats utt outfd)
Extract the features and write them to the file descriptor."
  (mapcar
   (lambda (si)
     (mapcar 
      (lambda (f) 
	(set! fval (unwind-protect (item.feat si f) "0"))
	(if (or (string-equal "" fval)
		(string-equal " " fval))
	    (format outfd "%l " fval)
	    (format outfd "%s " fval)))
      feats)
     (format outfd "\n")
     t)
   (utt.relation.items utt relname))
  t)

(define (get_utt fname)
  (utt.load nil fname))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   The main work
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (main)
  (get_options)

  (dump_all_features 
   desired_relation
   desired_features 
   utt_files
   output)
)

(main)