home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / examples / dumpfeats.sh < prev    next >
Lisp/Scheme  |  1999-09-09  |  7KB  |  179 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-*-mode:scheme-*-
  2. ;;                                                                       ;;
  3. ;;                Centre for Speech Technology Research                  ;;
  4. ;;                     University of Edinburgh, UK                       ;;
  5. ;;                       Copyright (c) 1996,1997                         ;;
  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. ;;  THE UNIVERSITY OF EDINBURGH 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 THE UNIVERSITY OF EDINBURGH 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. ;;;           Author:  Alan W Black
  34. ;;;           Date:    December 1997
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;;
  37. ;;;  Dump features from a list of utterances
  38. ;;;
  39.  
  40. ;;; Because this is a --script type file it has to explicitly
  41. ;;; load the initfiles: init.scm and user's .festivalrc
  42. (load (path-append libdir "init.scm"))
  43.  
  44. (define (dumpfeats_help)
  45.   (format t "%s\n"
  46.   "Usage: dumpfeats [options] <utt_file_0> <utt_file_1> ...
  47.   Dump features from a set of utterances
  48.   Options
  49.   -relation <string>
  50.              Relation from which the features have to be dumped from
  51.   -output <string>
  52.              If output parameter contains a %s its treated as a skeleton
  53.              e.g feats/%s.feats and multiple files will be created one
  54.              each utterance.  If output doesn't contain %s the output
  55.              is treated as a single file and all features and dumped in it.
  56.   -feats <string>
  57.              If argument starts with a \"(\" it is treated as a list of
  58.              features to dump, otherwise it is treated as a filename whose
  59.              contents contain a set of features (without parenetheses).
  60.   -eval <ifile>
  61.              A scheme file to be loaded before dumping.  This may contain
  62.              dump specific features etc.  If filename starts with a left
  63.              parenthis it it evaluated as lisp.
  64. ")
  65.   (quit))
  66.  
  67. ;;; Default options values
  68. (defvar utt_files nil)  ;; utterance files to dump from
  69. (defvar desired_relation nil)
  70. (defvar output "-")
  71. (defvar desired_features nil)
  72. (defvar extra-file nil)
  73.  
  74. ;;; Get options
  75. (define (get_options)
  76.   (let ((files nil)
  77.     (o argv))
  78.     (if (or (member_string "-h" argv)
  79.         (member_string "-help" argv)
  80.         (member_string "--help" argv)
  81.         (member_string "-?" argv))
  82.     (dumpfeats_help))
  83.     (while o
  84.       (begin
  85.     (cond
  86.      ((string-equal "-relation" (car o))
  87.       (if (not (cdr o))
  88.           (dumpfeats_error "no stream file specified"))
  89.       (set! desired_relation (car (cdr o)))
  90.       (set! o (cdr o)))
  91.      ((string-equal "-output" (car o))
  92.       (if (not (cdr o))
  93.           (dumpfeats_error "no output file/skeleton specified"))
  94.       (set! output (car (cdr o)))
  95.       (set! o (cdr o)))
  96.      ((string-equal "-feats" (car o))
  97.       (if (not (cdr o))
  98.           (dumpfeats_error "no feats list/file specified"))
  99.       (if (string-matches (car (cdr o)) "^(.*")
  100.           (set! desired_features (read-from-string (car (cdr o))))
  101.           (set! desired_features (load (car (cdr o)) t)))
  102.       (set! o (cdr o)))
  103.      ((string-equal "-eval" (car o))
  104.       (if (not (cdr o))
  105.           (dumpfeats_error "no file specified to load"))
  106.       (if (string-matches (car (cdr o)) "^(.*")
  107.           (eval (read-from-string (car (cdr o))))
  108.           (load (car (cdr o))))
  109.       (set! o (cdr o)))
  110.      (t
  111.       (set! files (cons (car o) files))))
  112.     (set! o (cdr o))))
  113.     (if files
  114.     (set! utt_files (reverse files)))))
  115.  
  116. (define (dumpfeats_error message)
  117.   (format stderr "%s: %s\n" "dumpfeats" message)
  118.   (dumpfeats_help))
  119.  
  120. ;;; No gc messages
  121. (gc-status nil)
  122.  
  123. (define (dump_all_features relname feats names outskeleton)
  124. "(dump_all_features relname feats names outskeleton)
  125. Dump all names features in RELNAME from utterances in NAMES
  126. to a files or files specified by outskeleton."
  127.   (let (fd)
  128.     (if (not (string-matches outskeleton ".*%s.*"))
  129.     (set! fd (fopen outskeleton "w")))
  130.     (mapcar
  131.      (lambda (uttfile)
  132.        (format stderr "%s\n" uttfile)
  133.        ;; change fd to new file if in skeleton mode
  134.        (if (string-matches outskeleton ".*%s.*")
  135.        (set! fd (fopen (format nil outskeleton
  136.                    (string-before 
  137.                     (basename uttfile) "."))
  138.                "w")))
  139.        (extract_feats 
  140.     relname 
  141.     feats 
  142.     (utt.load nil uttfile)
  143.     fd)
  144.        (if (string-matches outskeleton ".*%s.*")
  145.        (fclose fd)))
  146.      names)
  147.     (if (not (string-matches outskeleton ".*%s.*"))
  148.     (fclose fd))))
  149.  
  150. (define (extract_feats relname feats utt outfd)
  151.  "(extract_feats relname feats utt outfd)
  152. Extract the features and write them to the file descriptor."
  153.   (mapcar
  154.    (lambda (si)
  155.      (mapcar 
  156.       (lambda (f) 
  157.     (format outfd "%s " (item.feat si f)))
  158.       feats)
  159.      (format outfd "\n"))
  160.    (utt.relation.items utt relname)))
  161.  
  162. (define (get_utt fname)
  163.   (utt.load nil fname))
  164.  
  165. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  166. ;;;   The main work
  167. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  168. (define (main)
  169.   (get_options)
  170.  
  171.   (dump_all_features 
  172.    desired_relation
  173.    desired_features 
  174.    utt_files
  175.    output)
  176. )
  177.  
  178. (main)
  179.