;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                       ;;
;;;                     Carnegie Mellon University                        ;;
;;;                      Copyright (c) 2005-2011                          ;;
;;;                        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.                                                      ;;
;;;                                                                       ;;
;;;  CARNEGIE MELLON UNIVERSITY 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 CARNEGIE MELLON UNIVERSITY 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 (awb@cs.cmu.edu) Nov 2005                       ;;
;;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                       ;;
;;;  Run Time Synthesis support for clustergen (HMM-generation) voices    ;;
;;;                                                                       ;;
;;;  This is voice-independant, and should be in festival/lib but is      ;;
;;;  currently copied into each voice's festvox/ directory                ;;
;;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar cluster_synth_pre_hooks nil)
(defvar cluster_synth_post_hooks nil)
(defvar clustergen_mcep_trees nil)
(defvar cg:initial_frame_offset 0.0)
(defvar cg:frame_shift 0.005)
(set! mlsa_beta_param 0.4)
(set! cg:mlsa_lpf t)

(set! framerate 16000)
(cond
 ;; This mapping should match that in do_clustergen for mcep_sptk_deltas
 ((equal? framerate 8000) (set! mlsa_alpha_param 0.312))
 ((equal? framerate 11025) (set! mlsa_alpha_param 0.357))
 ((equal? framerate 16000) (set! mlsa_alpha_param 0.42))
 ((equal? framerate 22050) (set! mlsa_alpha_param 0.455))
 ((equal? framerate 32000) (set! mlsa_alpha_param 0.504))
 ((equal? framerate 44100) (set! mlsa_alpha_param 0.544))
 ((equal? framerate 48000) (set! mlsa_alpha_param 0.554))
 (t
  (format t "Unknown framerate %d for mlsa_alpha_param\n" framerate)
  (exit)))
(set! mcep_length 25)

;;; deltas/mlpg
(defvar cg:F0_smooth t)
(set! cg:F0_interpolate t) ;; spline interpolation
(defvar cg:param_smooth nil) ;; not as good as mlpg
(defvar cg:mlpg t)
(defvar cg:gv nil)
(defvar cg:vuv nil)
(defvar cg:with_v t)
(defvar cg:deltas t)
(defvar cg:debug nil)
(defvar cg:save_param_track nil)
(defvar cg:expand_dynamic_features nil) ;; explicitly add ph_* lisp_* features
(defvar cg:save_dumped_coeff_files nil) ;; don't delete festival/coeffs/*

(set! cg:multimodel nil)  ;; probably doesn't work any more!
(set! cg:mcep_clustersize 15)
(set! cg:f0_clustersize 150)
(set! cg:rfs 20) ;; random forests, set this to 20 to get 20 rfs
(defvar cg:rfs_models nil)  ;; will get loaded at synthesis time
(set! cg:rfs_dur 20) ;; random forests for duration
(defvar cg:rfs_dur_models nil)  ;; will get loaded at synthesis time
(defvar cg:rfs_prune_stats nil) ;; t to print out senome usage stats
(defvar cg:gmm_transform nil)
(set! cg:mixed_excitation t)  ;; t if ccoeffs contain 5 strength features
(set! cg:spamf0 nil)
(set! cg:spamf0_viterbi nil)
(set! cg:vuv_predict_dump nil)
;; Can be used for external prediction models
(set! cg:post_filter nil)
(set! cg:post_filter_script_name "./bin/post_filter")

(defvar me_filter_track nil)
(defvar lpf_track nil)

;; Set Phrasyn Parameters
(set! cg:phrasyn nil)
(set! cg:phrasyn_grammar_ntcount 10)
(set! cg:phrasyn_mode 'pos)
;(set! cg:phrasyn_mode 'gpos)

(if cg:spamf0
    (require 'spamf0))

(if cg:post_filter
    (set! post_filter_feats (mapcar car (cdr (car (load "festival/clunits/mcep.desc" t))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  The main CG synthesis voice, voices using CG should set
;;     (Parameter.set 'Synth_Method 'ClusterGen)
;;  which is done in INST_LANG_VOX_cg.scm
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defSynthType ClusterGen

    (apply_hooks cluster_synth_pre_hooks utt)

    (set! clustergen_utt utt) ;; a global variable for debugging

    ;; Build the state relation
    (ClusterGen_make_HMMstate utt)
    ;; Predict number of frames
    (ClusterGen_make_mcep utt) ;; durations for # of vectors
    ;; Then predict the frame values

    (if cg:expand_dynamic_features
        (ClusterGen_expand_dynamic_features utt))

    (if (assoc 'cg::trajectory clustergen_mcep_trees)
        (ClusterGen_predict_trajectory utt) ;; predict trajectory (or ola)
        (ClusterGen_predict_mcep utt) ;; predict vector types
        )
;    (ClusterGen_predict_cgv utt) ;; predict vectors by viterbi

    ;; Convert predicted mcep track into a waveform
    (if cg:gmm_transform
        (cg_do_gmm_transform utt)  ;; GMM (MLPG again) and MLSA
        )

    (if cg:spamf0
	(set! utt (spamf0_utt utt))
    )
 
    (cluster_synth_method utt) ;; standard MLSA only

    (if cg:save_param_track
        (track.save (utt.feat utt "param_track") "param.track"))

    (apply_hooks cluster_synth_post_hooks utt)
    utt
)

;; Knowledge-free structural dynamic features
(define (edf_num_prev i)
  (let ((p (item.prev i)))
    (if (null p)
        0
        (+ 1 (edf_num_prev p)))))
(define (edf_num_next i)
  (let ((n (item.next i)))
    (if (null n)
        0
        (+ 1 (edf_num_next n)))))
(define (edf_position i)
  (let ((ps (edf_num_prev i)))
    (/ (+ 1 ps)
       ;; Ensure we never get 0                                                 
       (+ 1 ps (edf_num_next i)))))
(define (edf_parents_daughters i)
  (if (null (item.parent i))
     0
     (edf_num_descendant (item.parent i))))
(define (edf_dtype 1)
  (if (null (item.next i))
      (if (null (item.prev i))
         's
         'b)
      (if (null (item.prev i))
         'e
         'm)))
(define (edf_num_ancestor i)
  (if (item.parent i)
      0
      (+ 1 (edf_num_ancestor (item.parent i)))))
(define (edf_num_descendant i)
  (if (item.daughtern i)
      0
      (+ 1 (edf_num_descendant (item.daughtern i)))))
(define (edf_ancestor_position i)
  (/ (+ 1 (edf_num_ancestor))
     ;; Ensure we never get 0
     (+ 1 (edf_num_ancestor i) (edf_num_descendant i))))
(define (edf_num_daughters i)
  (length (item.daughters i)))
;;(define (edf_prevparent_equal_parentprev i)
;;  (if (and (item.parent i)
;;           (


;; previous parent equal parent previous

(define (ClusterGen_expand_dynamic_features utt)
  "(ClusterGen_expand_dynamic_features utt) 
For arbitrary downstream machine learning (and other reasons)
sometimes you want features to be explicitly present as local
features/values on the items.  This does this -- yes it might not be
the most efficient technique but it can make some things easier).
This first implementation however does this naively, it gets the
value from the feature at this point in the process, later changes could
potentially affect the dynamic features so they will not get appropriate
updated -- but this comment will be ignored by everyone until I point them
at it."
  (mapcar
   (lambda (seg)
     ;; The phonetic features
     (mapcar 
      (lambda (phf)
        (item.set_feat seg (format nil "ph_%s" phf)
                  (item.feat seg (format nil "ph_%s" phf))))
      ;; Should be got automatically from the phoneme set 
      '(vc vlng vheight vfront vrnd ctype cplace cvox))
     t)
   (utt.relation.items utt 'Segment))

  ;; Others 
  (mapcar
   (lambda (word)
     (item.set_feat word "gpos" (item.feat word "gpos")))
   (utt.relation.items utt 'Word))
  (mapcar
   (lambda (syl)
     (item.set_feat syl "lisp_cg_break" (item.feat syl "lisp_cg_break"))
     (item.set_feat syl "position_type" (item.feat syl "position_type"))
     )
   (utt.relation.items utt 'Syllable))
  (mapcar
   (lambda (m)
     (mapcar 
      (lambda (f) (item.set_feat m f (item.feat m f)))
      '(lisp_cg_phone_place
        lisp_cg_state_index
        lisp_cg_phone_rindex
        lisp_cg_phone_index
        lisp_cg_state_rindex
        lisp_cg_position_in_phrasep
        lisp_cg_state_place
        lisp_cg_position_in_phrase)))
   (utt.relation.items utt 'mcep))

  (mapcar 
   (lambda (r)
     (mapcar
      (lambda (i)
        (mapcar
         (lambda (f) 
           (item.set_feat i (format nil "R_%s_%s" r f)
                          (item.feat i (format nil "lisp_%s" f))))
         '(edf_num_prev
           edf_num_next
           edf_position
           edf_num_daughters
           edf_parents_daughters
           edf_dtype)))
      (utt.relation.items utt r)))
   (utt.relationnames utt))

  utt
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Various waveform resynthesis wraparound functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cg_wave_synth_external utt)
  ;; before we had it built-in to Festival
  (let ((trackname (make_tmp_filename))
        (wavename (make_tmp_filename))
        )
    (track.save (utt.feat utt "param_track") trackname "est")
    (system
     (format nil "$FESTVOXDIR/src/clustergen/cg_resynth %s %s"
             trackname wavename))
    (utt.import.wave utt wavename)
    (delete-file trackname)
    (delete-file wavename)
    utt)
)

(define (cg_wave_synth utt)
  (utt.relation.create utt 'Wave)
  (if cg:mixed_excitation
    (item.set_feat 
     (utt.relation.append utt 'Wave) 
     "wave"
     (mlsa_resynthesis
      (utt.feat utt "param_track")
      (utt.feat utt "str_params")
      me_filter_track))
    ;; Not mixed excitation
    (item.set_feat 
     (utt.relation.append utt 'Wave) 
     "wave" 
     (mlsa_resynthesis (utt.feat utt "param_track") nil lpf_track)))
    utt)

(define (cg_wave_synth_sptk utt)
  ;; before we had it built-in to Festival
  (let ((trackname (make_tmp_filename))
        (wavename (make_tmp_filename))
        )
    (track.save (utt.feat utt "param_track") trackname "est")
    (system
     (format nil "$FESTVOXDIR/src/clustergen/cg_mlsa2 %s %s"
             trackname wavename))
    (utt.import.wave utt wavename)
    (delete-file trackname)
    (delete-file wavename)
    utt)
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; CGA is a basic voice morphing/adaptation  technique using cg -- 
;; it is very much experimental and incomplete
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (cg_wave_synth_cga utt)
  ;; Use loaded cga model to predict a new map_track
  (format t "In Synth CGA\n")

  (cga:create_map utt)  ;; generate map_track
  (cga:predict_map utt)
  
  (utt.relation.create utt 'Wave)
  (item.set_feat 
   (utt.relation.append utt 'Wave) 
   "wave" 
   (mlsa_resynthesis (utt.feat utt "map_track")))
  utt)

(define (cga:create_map utt)
  ;; predict the map_param converted parameters

  ;; Need to do better duration stuff
  (set! map_track (track.copy (utt.feat utt "param_track")))
  (utt.set_feat utt "map_track" map_track)

  (utt.relation.create utt "param_map")
  (utt.relation.create utt "param_map_link")

  (set! pseg (utt.relation.first utt "mcep"))
  (set! m 0)
  (while pseg
     (set! mcep_parent (utt.relation.append utt "param_map_link" pseg))
     (set! mseg (utt.relation.append utt "param_map"))
     (item.append_daughter mcep_parent mseg)
     (item.set_feat mseg "frame_number" m)
     (item.set_feat mseg "name"
                         (item.feat mseg "R:param_map_link.parent.name"))
     (set! m (+ 1 m))
     (set! pseg (item.next pseg)))
  utt
)

(define (cga:predict_map utt)
  (let (i j f map_track num_channels
          s_f0_mean s_f0_stddev
          t_f0_mean t_f0_stddev)

  (set! i 0)
  (set! map_track (utt.feat utt "map_track"))
  (set! num_channels (track.num_channels map_track))

  (set! s_f0_mean (get_param 'cga::source_f0_mean clustergen_cga_trees 140))
  (set! s_f0_stddev (get_param 'cga::source_f0_stddev clustergen_cga_trees 20))
  (set! t_f0_mean (get_param 'cga::target_f0_mean clustergen_cga_trees 140))
  (set! t_f0_stddev (get_param 'cga::target_f0_stddev clustergen_cga_trees 20))

  (mapcar
   (lambda (x)
     (let ((map_tree (assoc_string (item.name x) clustergen_cga_trees)))
       (if (null map_tree)
           (format t "ClusterGenCGA: can't find cluster tree for %s\n"
                   (item.name x))
           (begin
             (set! frame (wagon x (cadr map_tree)))
             ;; Convert f0
             (if (> (track.get map_track i 0) 0)
                 (track.set 
                  map_track i 0
                  (+ t_f0_mean
                     (* t_f0_stddev
                        (/ (- (track.get map_track i 0) s_f0_mean)
                           s_f0_stddev)))))
             (set! j 1)
             (set! f (car frame))
             (while (< j num_channels)
                (track.set map_track i j 
                   (track.get clustergen_cga_vectors f (* 2 j)))
                (set! j (+ 1 j)))))
       (set! i (+ 1 i))))
   (utt.relation.items utt "param_map"))

  utt))

(define (ClusterGen_predict_states seg)
  ;; The names may change
  (cdr (assoc_string (item.name seg) phone_to_states)))

(define (ClusterGen_make_HMMstate utt)
  (let ((states)
        (segstate)
        (statepos))
    ;; Make HMMstate relation and items (three per phone)
    (utt.relation.create utt "HMMstate")
    (utt.relation.create utt "segstate")
    
    (mapcar
     (lambda (seg)
       (set! statepos 1)
       (set! states (ClusterGen_predict_states seg))
       (set! segstate (utt.relation.append utt 'segstate seg))
       (while states
          (set! state (utt.relation.append utt 'HMMstate))
          (item.append_daughter segstate state)
          (item.set_feat state "name" (car states))
          (item.set_feat state "statepos" statepos)
          (set! statepos (+ 1 statepos))
          (set! states (cdr states)))
       )
     (utt.relation.items utt 'Segment))
    )
)

(define (CG_predict_state_duration state)
  (if cg:rfs_dur
      ;; Random forest prediction 
      (/ 
       (apply +
        (mapcar (lambda (dm) (wagon_predict state dm))
                cg:rfs_dur_models))
       (length cg:rfs_dur_models))
      ;; single model
      (wagon_predict state duration_cart_tree_cg)
      ))

(define (ClusterGen_state_duration state)
  (let ((zdur (CG_predict_state_duration state))
        (ph_info (assoc_string (item.name state) duration_ph_info_cg))
        (seg_stretch (item.feat state "R:segstate.parent.dur_stretch"))
        (syl_stretch (item.feat state "R:segstate.parent.R:SylStructure.parent.dur_stretch"))
        (tok_stretch (parse-number (item.feat state "R:segstate.parent.R:SylStructure.parent.parent.R:Token.parent.dur_stretch")))
        (global_stretch (Parameter.get 'Duration_Stretch))
        (stretch 1.0))
    (if (string-matches (item.name state) "pau_.*")
        ;; Its a pau so explicitly set the duration
        ;; Note we want sentence internal pauses to be about 100ms
        ;; and sentence final pauses to be 150ms, but there will also
        ;; sentence initial pauses of 150ms so we can treat all pauses as
        ;; 100ms, there are three states so we use 50ms
        (set! zdur 
              (/ (- 0.05 (car (cdr ph_info)))
                 (car (cdr (cdr ph_info))))))
    (if (not (string-equal seg_stretch "0"))
        (setq stretch (* stretch seg_stretch)))
    (if (not (string-equal syl_stretch "0"))
        (setq stretch (* stretch syl_stretch)))
    (if (not (string-equal tok_stretch "0"))
        (setq stretch (* stretch tok_stretch)))
    (if (not (string-equal global_stretch "0"))
        (setq stretch (* stretch global_stretch)))
    (if ph_info
        (* stretch
           (+ (car (cdr ph_info)) ;; mean
              (* (car (cdr (cdr ph_info))) ;; stddev
                 zdur)))
        (begin
          (format t "ClusterGen_state_duration: no dur phone info for %s\n"
                  (item.name state))
          0.1))))

(define (ClusterGen_make_mcep utt)
  ;; Well its really make params (whatever type they are), 
  ;; they might not be mceps 
  ;; Note this just makes the vectors, it doesn't predict the
  ;; values of the vectors -- see predict_mcep below
  (let ((num_frames 0)
        (frame_advance cg:frame_shift)
        (end 0.0)
        (hmmstate_dur))

    ;; Make HMMstate relation and items (three per phone)
    (utt.relation.create utt "mcep")
    (utt.relation.create utt "mcep_link")
    (mapcar
     (lambda (state)
       ;; Predict Duration
       (set! start end)
       (set! hmmstate_dur (ClusterGen_state_duration state))
       (if (< hmmstate_dur frame_advance)
           (set! hmmstate_dur frame_advance))
       (set! end (+ start hmmstate_dur))
       (item.set_feat state "end" end)
       ;; create that number of mcep frames up to state end
       (set! mcep_parent (utt.relation.append utt 'mcep_link state))
       (while (<= (* (+ 0 num_frames) frame_advance) end)
              (set! mcep_frame (utt.relation.append utt 'mcep))
              (item.append_daughter mcep_parent mcep_frame)
              (item.set_feat mcep_frame "frame_number" num_frames)
              (item.set_feat mcep_frame "name" (item.name mcep_parent))
              (set! num_frames (+ 1 num_frames))
              )
       )
     
     (utt.relation.items utt 'HMMstate))

    ;; Copy the final state end back up on to the segment for consistency
    (mapcar
     (lambda (seg)
       (item.set_feat seg "end" (item.feat seg "R:segstate.daughtern.end")))
     (utt.relation.items utt 'Segment))

    (utt.set_feat utt "param_track_num_frames" num_frames)
    utt)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Some feature functions specific to CG, some of these are just
;; experimental
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (mcep_24 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   24))
(define (mcep_23 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   23))
(define (mcep_22 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   22))
(define (mcep_21 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   21))
(define (mcep_20 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   20))
(define (mcep_19 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   19))
(define (mcep_18 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   18))
(define (mcep_17 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   17))
(define (mcep_16 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   16))
(define (mcep_15 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   15))
(define (mcep_14 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   14))
(define (mcep_13 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   13))
(define (mcep_12 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   12))
(define (mcep_11 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   11))
(define (mcep_10 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   10))
(define (mcep_9 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   9))
(define (mcep_8 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   8))
(define (mcep_7 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   7))
(define (mcep_6 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   6))
(define (mcep_5 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   5))
(define (mcep_4 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   4))
(define (mcep_3 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   3))
(define (mcep_2 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   2))
(define (mcep_1 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   1))
(define (mcep_0 i)
  (track.get
   (utt.feat (item.get_utt i) "param_track")
   (item.feat i "frame_number")
   0))
(define (v_value i)
  (track.get 
   clustergen_param_vectors 
   (item.feat i "clustergen_param_frame")
   (- (track.num_channels clustergen_param_vectors) 2))
)

(define (cg_break s)
  "(cg_break s)
0, if word internal, 1 if word final, 4 if phrase final, we ignore 
3/4 distinguinction in old syl_break"
  (let ((x (item.feat s "syl_break")))
    (cond
     ((string-equal "0" x)
      (string-append x))
     ((string-equal "1" x)
      (string-append x))
     ((string-equal "0" (item.feat s "R:SylStructure.parent.n.name"))
      "4")
     (t
      "3"))))

(define (cg_frame_voiced s)
  (if (and (string-equal "-"
            (item.feat 
             s "R:mcep_link.parent.R:segstate.parent.ph_vc"))
           (string-equal "-"
            (item.feat 
             s "R:mcep_link.parent.R:segstate.parent.ph_cvox")))
      0
      1)
)

(define (cg_duration i)
  (if (item.prev i)
      (- (item.feat i "end") (item.feat i "p.end"))
      (item.feat i "end")))

(define (cg_state_pos i)
  (let ((n (item.name i)))
  (cond
   ((not (string-equal n (item.feat i "p.name")))
    "b")
   ((string-equal n (item.feat i "n.name"))
    "m")
   (t
    "e"))))

(define (cg_state_place i)
  (let ((start (item.feat i "R:mcep_link.parent.daughter1.frame_number"))
        (end (item.feat i "R:mcep_link.parent.daughtern.frame_number"))
        (this (item.feat i "frame_number")))
    (if (eq? 0.0 (- end start))
        0
        (/ (- this start)
           (- end start)))))

(define (cg_state_index i)
  (let ((start (item.feat i "R:mcep_link.parent.daughter1.frame_number"))
        (this (item.feat i "frame_number")))
    (- this start)))

(define (cg_state_rindex i)
  (let ((end (item.feat i "R:mcep_link.parent.daughtern.frame_number"))
        (this (item.feat i "frame_number")))
    (- end this)))

(define (cg_phone_place i)
  (let ((start (item.feat i "R:mcep_link.parent.R:segstate.parent.daughter1.R:mcep_link.daughter1.frame_number"))
        (end (item.feat i "R:mcep_link.parent.R:segstate.parent.daughtern.R:mcep_link.daughtern.frame_number"))
        (this (item.feat i "frame_number")))
    (if (eq? 0.0 (- end start))
        0
        (/ (- this start)
           (- end start)))))

(define (cg_phone_index i)
  (let ((start (item.feat i "R:mcep_link.parent.R:segstate.parent.daughter1.R:mcep_link.daughter1.frame_number"))
        (this (item.feat i "frame_number")))
    (- this start)))

(define (cg_phone_rindex i)
  (let ((end (item.feat i "R:mcep_link.parent.R:segstate.parent.daughtern.R:mcep_link.daughtern.frame_number"))
        (this (item.feat i "frame_number")))
    (- end this)))

(define (cg_utt_fileid i)
  (utt.feat (item.get_utt i) "fileid"))

(define (cg_utt_speaker i)
  ;; Will only work with spk_arctic_.... fileids 
  (string-before (utt.feat (item.get_utt i) "fileid") "_")
)

(define (cg_position_in_sentenceX x)
  (/ (item.feat x "R:mcep_link.parent.end")
     (item.feat x "R:mcep_link.parent.R:segstate.parent.R:Segment.last.end")))

(define (cg_position_in_sentence x)
  (let ((sstart (item.feat 
                 x 
                 "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Word.first.R:SylStructure.daughter1.daughter1.R:Segment.p.end"))
        (send (item.feat 
               x 
               "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Word.last.R:SylStructure.daughtern.daughtern.R:Segment.end")))
    (set! xyx
    (if (eq? 0.0 (- send sstart))
        -1
        (/ (- (* cg:frame_shift (item.feat x "frame_number")) sstart)
           (- send sstart))))
;    (format t "cg_position_in_sentence2 %f\n" xyx)
    xyx
    ))

(define (cg_find_phrase_number x)
  (cond
   ((item.prev x)
    (+ 1 (cg_find_phrase_number (item.prev x))))
   (t
    0)))

(define (cg_find_rphrase_number x)
  (cond
   ((item.next x)
    (+ 1 (cg_find_rphrase_number (item.next x))))
   (t
    0)))

(define (cg_position_in_phrase x)
  (let ((pstart (item.feat 
                 x 
                 "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Phrase.parent.daughter1.R:SylStructure.daughter1.daughter1.R:Segment.p.end"))
        (pend (item.feat 
               x 
               "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Phrase.parent.daughtern.R:SylStructure.daughtern.daughtern.R:Segment.end"))
        (phrasenumber 
         (item.feat 
          x
          "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Phrase.parent.lisp_cg_find_phrase_number")))
    (set! xyx
    (if (eq? 0.0 (- pend pstart))
        -1
        (+ 0 ;phrasenumber
        (/ (- (* cg:frame_shift (item.feat x "frame_number")) pstart)
           (- pend pstart)))))
;    (format t "cg_position_in_phrase %f\n" xyx)
    xyx
    )
    )

(define (cg_position_in_phrasep x)
  (let ((pstart (item.feat 
                 x 
                 "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Phrase.parent.daughter1.R:SylStructure.daughter1.daughter1.R:Segment.p.end"))
        (pend (item.feat 
               x 
               "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Phrase.parent.daughtern.R:SylStructure.daughtern.daughtern.R:Segment.end"))
        (phrasenumber 
         (item.feat 
          x
          "R:mcep_link.parent.R:segstate.parent.R:SylStructure.parent.parent.R:Phrase.parent.lisp_cg_find_phrase_number")))
    (set! xyx
    (if (eq? 0.0 (- pend pstart))
        -1
        (+ phrasenumber
        (/ (- (* cg:frame_shift (item.feat x "frame_number")) pstart)
           (- pend pstart)))))
;    (format t "cg_position_in_phrase %f\n" xyx)
    xyx
    )
    )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Smoothing functions (sort of instead of mlpg)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cg_F0_smooth track j)
  (let ((p 0.0)
        (i 0)
        (num_frames (- (track.num_frames track) 1)))

    (set! i 1)
    (while (< i num_frames)
      (set! this (track.get track i j))
      (set! next (track.get track (+ i 1) j))
      (if (> this 0.0)
          (track.set 
           track i j
           (/ (+ (if (> p 0.0) p this)
                 this
                 (if (> next 0.0) next this))
              3.0)))
      (set! p this)
      (set! i (+ 1 i)))
    )
)

(define (cg_mcep_smooth track j)
  (let ((p 0.0)
        (i 0)
        (num_frames (- (track.num_frames track) 1)))

    (set! i 1)
    (while (< i num_frames)
      (set! this (track.get track i j))
      (set! next (track.get track (+ i 1) j))
      (track.set track i j (/ (+ p this next) 3.0))
      (set! p this)
      (set! i (+ 1 i)))
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; For normal synthesis make unvoiced states unvoiced, but we don't
;; do this during testing

(defvar cg_predict_unvoiced t)

(define (ClusterGen_predict_F0 mcep f0_val param_track)
  "(ClusterGen_predict_F0 mcep frame param_track)
Predict the F0 (or not)."
  (if (and cg_predict_unvoiced
           (string-equal "-"
            (item.feat 
             mcep "R:mcep_link.parent.R:segstate.parent.ph_vc"))
           (string-equal "-"
            (item.feat 
             mcep "R:mcep_link.parent.R:segstate.parent.ph_cvox")))
      (track.set param_track i 0 0.0) ;; make it unvoiced (silence)
      (track.set param_track i 0 f0_val)) ;; make it voiced
  )

(define (ClusterGen_mcep_voiced mcep)
  (if (and cg_predict_unvoiced
           (string-equal "-"
            (item.feat 
             mcep "R:mcep_link.parent.R:segstate.parent.ph_vc"))
           (string-equal "-"
            (item.feat 
             mcep "R:mcep_link.parent.R:segstate.parent.ph_cvox")))
      nil
      t))

;(set! cg_vuv_tree (car (load "vuv/vuv.tree" t)))
;; Default voice/unvoiced prediction: can be trained with bin/make_vuv_model
(defvar cg_vuv_tree
  '((lisp_v_value < 5.5) ((0)) ((1))))

(define (ClusterGen_voicing_v mcep)
  (let ((vp (car (last (wagon mcep cg_vuv_tree)))))
    (if cg:vuv_predict_dump
        (begin  ;; only used at vuv_model build time 
          (mapcar
           (lambda (f) (format cg:vuv_predict_dump "%s " (item.feat mcep f)))
           cg_vuv_predict_features)
          (format cg:vuv_predict_dump "\n")))
    (cond
     ((string-equal "pau" (item.feat mcep "R:mcep_link.parent.R:segstate.parent.name"))
      ;; pauses are always unvoiced
      nil)
     ((equal? vp 1)
      t)
     (t
      nil))))

(define (ClusterGen_voicing_v_traj mcep i params)
  (let ((vvv (track.get params i 102)))
;  (format t "%s %f\n" (item.name mcep) vvv)
    (cond
     ((string-equal "pau" (item.feat mcep "R:mcep_link.parent.R:segstate.parent.name"))
      ;; pauses are always unvoiced
      nil)
     ((string-equal 
       "+" 
       (item.feat mcep "R:mcep_link.parent.R:segstate.parent.ph_vc"))
      ;; vowels are always voiced
      t)
     ((> vvv 0.4)
      ;; consonants are what they are
      t)
     (t
      nil))))

(define (cg_do_gmm_transform utt)
  "(cmu_us_rms_transform::convfilter utt)
Filter synthesized voice with transformation filter and reload waveform."
   (let ((wfile1 (make_tmp_filename))
	 (wfile2 (make_tmp_filename))
         (wfile3 (make_tmp_filename))
         (wfile4 (make_tmp_filename))
         )

     (utt.save utt wfile3)
     (track.save (utt.feat utt "param_track") wfile4)

     (system
      (format 
       nil
       "(cd %s && csh $FESTVOXDIR/src/vc/scripts/VConvFestival_cg.csh $FESTVOXDIR/src/vc/src param/source-target_param.list %s %s %s %s)"
       "vc"  ;; Need a way set this with the voice dir
       wfile1  ;; input file
       wfile3  ;; utterance  
       wfile4  ;; predicted param file
       wfile2))

     (set! new_track (track.load wfile2))
     (utt.set_feat utt "param_track" new_track)
     (delete-file wfile1)
     (delete-file wfile2)
     (delete-file wfile3)
     (delete-file wfile4)

     utt
     ))

(define (cg_do_mlpg param_track)
  ;; do mlpg on the params
  (if (boundp 'mlpg)
      (begin
        (mlpg param_track))
      (begin ;; old version with external mlpg script
        (let ((trackname (make_tmp_filename))
              (mlpgtrack (make_tmp_filename)) )
          (track.save param_track trackname "est")
          (if cg:gv
              (begin
                (format t "with gv\n")
                (system
                 (format nil "$FESTVOXDIR/src/clustergen/cg_mlpg %s %s %s %s"
                         trackname mlpgtrack 
                         cg_gv_vm_filename cg_gv_vv_filename )))
              (system
               (format nil "$FESTVOXDIR/src/clustergen/cg_mlpg %s %s"
                       trackname mlpgtrack)))
          (set! postmlpg (track.load mlpgtrack))
          (delete-file trackname)
          (delete-file mlpgtrack)
          postmlpg)
        )))
      
(define (cg_all_f0 m)
  ;; global prediction of F0, not unit specific
  (let ((all_f0 (wagon m (cadr (assoc_string "all" clustergen_f0_all)))))
    (cadr all_f0)))

(define (cg_all_f0f0 m)
  ;; global prediction of F0, difference
  (let ((all_f0 (wagon m (cadr (assoc_string "all" clustergen_f0_all))))
        (all_f0f0 (wagon m (cadr (assoc_string "all_f0_diff" clustergen_f0_all)))))
    (- (cadr all_f0) (cadr all_f0f0))))

(define (cg_F0_interpolate_linear utt param_track)
  (mapcar
   (lambda (syl)
     (set! start_index
           (item.feat syl "R:SylStructure.daughter1.R:segstate.daughter1.R:mcep_link.daughter1.frame_number"))
     (set! end_index 
           (item.feat syl "R:SylStructure.daughtern.R:segstate.daughter1.R:mcep_link.daughtern.frame_number"))
     (set! mid_index (nint (/ (+ start_index end_index) 2.0)))
           
     (set! start_f0 (track.get param_track start_index 0))
     (set! mid_f0 (track.get param_track mid_index 0))
     (set! end_f0 (track.get param_track (- end_index 1) 0))
;     (format t "Syl: %s %d %f %d %f %d %f \n"
;             (item.feat syl "R:SylStructure.parent.name")
;             start_index start_f0
;             mid_index mid_f0
;             end_index end_f0)
     (set! m (/ (- mid_f0 start_f0) (- mid_index start_index)))
     (set! i 1)
     (while (< (+ i start_index) mid_index)
;            (format t "  %l %l\n" (+ i start_index) (+ start_f0 (* i m)))
            (track.set param_track (+ i start_index) 0
                       (+ start_f0 (* i m)))
            (set! i (+ i 1)))

     (set! m (/ (- end_f0 mid_f0) (- end_index mid_index)))
     (set! i 1)
     (while (< (+ i mid_index) end_index)
            (track.set param_track (+ i mid_index) 0
                       (+ mid_f0 (* i m)))
            (set! i (+ i 1)))
     )
   (utt.relation.items utt 'Syllable))
  utt
)
(define (catmull_rom_spline p p0 p1 p2 p3)
  ;; http://www.mvps.org/directx/articles/catmull/
  (let ((q nil))
    (set! q (* 0.5 (+ (* 2 p1)
            (* (+ (* -1 p0) p2) p)
            (* (+ (- (* 2 p0) (* 5 p1)) (- (* 4 p2) p3)) (* p p))
            (* (+ (* -1 p0) (- (* 3 p1) (* 3 p2)) p3) (* p p p)))))
;    (format t "crs: %f  %f  %f %f %f %f\n"
;            q p p0 p1 p2 p3)
    q))
     
(define (cg_F0_interpolate_spline utt param_track)
  (set! mid_f0 -1)
  (set! end_f0 -1)
  (mapcar
   (lambda (syl)
     (set! start_index
           (item.feat syl "R:SylStructure.daughter1.R:segstate.daughter1.R:mcep_link.daughter1.frame_number"))
     (set! end_index 
           (item.feat syl "R:SylStructure.daughtern.R:segstate.daughtern.R:mcep_link.daughtern.frame_number"))
           
     (set! mid_index (nint (/ (+ start_index end_index) 2.0)))

     (set! start_f0 (track.get param_track start_index 0))
     (if (> end_f0 0) (set! start_f0 end_f0))
     (if (< mid_f0 0)
         (set! pmid_f0 start_f0)
         (set! pmid_f0 mid_f0))
     (set! mid_f0 (track.get param_track mid_index 0))
     (if (item.next syl)
         (set! end_f0 
               (/ (+ (track.get param_track (- end_index 1) 0)
                     (track.get param_track end_index 0)) 2.0))
         (set! end_f0 (track.get param_track (- end_index 1) 0)))
     (set! nmid_f0 end_f0)

     (if (item.next syl)
         (begin
           (set! nsi
           (item.feat syl "n.R:SylStructure.daughter1.R:segstate.daughter1.R:mcep_link.daughter1.frame_number"))
           (set! nei
                 (item.feat syl "n.R:SylStructure.daughtern.R:segstate.daughtern.R:mcep_link.daughtern.frame_number"))
           (set! nmi (nint (/ (+ nsi nei) 2.0)))
           (set! nmid_f0 (track.get param_track nmi 0))))
     
;     (format t "Syl: %s  %2.1f  %d %2.1f  %d %2.1f  %d %2.1f  %2.1f %d\n"
;             (item.feat syl "R:SylStructure.parent.name")
;             pmid_f0
;             start_index start_f0
;             mid_index mid_f0
;             end_index end_f0
;             nmid_f0
;             end_index)

     (set! m (/ 1.0 (- mid_index start_index)))
     (set! i 0)
     (while (< (+ i start_index) mid_index)
            (track.set param_track 
                       (+ i start_index) 0
                       (catmull_rom_spline 
                        (* i m) pmid_f0 start_f0 mid_f0 end_f0))
            (set! i (+ i 1)))

     (set! m (/ 1.0 (- end_index mid_index)))
     (set! i 0)
     (while (< (+ i mid_index) end_index)
            (track.set param_track 
                       (+ i mid_index) 0
                       (catmull_rom_spline 
                        (* i m) start_f0 mid_f0 end_f0 nmid_f0))
            (set! i (+ i 1)))
     )
   (utt.relation.items utt 'Syllable))
  utt
)
(set! cg_F0_interpolate cg_F0_interpolate_spline)

(define (ClusterGen_predict_mcep utt)
  (let ((param_track nil)
        (frame_advance cg:frame_shift)
        (frame nil) (f nil) (f0_val)
        (cg_name_feature "name")
        (num_channels 
         (/ (track.num_channels clustergen_param_vectors)
            (if cg:mlpg 1 2)))
        (num_frames (utt.feat utt "param_track_num_frames"))
        )

    ;; Predict mcep values
    (set! i 0)
    (set! param_track (track.resize nil num_frames num_channels))
    (utt.set_feat utt "param_track" param_track)

    (mapcar
     (lambda (mcep)
       ;; Predict mcep frame
       (set! mcep_name (item.feat mcep cg_name_feature))
       (let ((mcep_tree 
              (assoc_string mcep_name clustergen_mcep_trees))
             (mcep_tree_delta
              (assoc_string mcep_name
               (if cg:multimodel
                   clustergen_delta_mcep_trees nil)))
             (mcep_tree_str
              (assoc_string
               mcep_name
               (if (boundp 'clustergen_str_mcep_trees)
                   clustergen_str_mcep_trees nil)))
             (f0_tree 
              (assoc_string 
;               "all"
               mcep_name
               clustergen_f0_trees))
)
         (if (null mcep_tree)
             (format t "ClusterGen: can't find cluster tree for %s\n"
                     (item.name mcep))
             (begin
               ;; F0 prediction
               (set! f0_val 
                     (wagon mcep (cadr f0_tree))
;                     (list 1.0 (cg_all_f0 mcep))
                     )

               (if cg:rfs
                   (set! f0_val
                         (list 'filler
                         (/ (apply +  ;; average f0 val over the models
                           (mapcar
                            (lambda (trees)
                              (cadr (wagon mcep
                                     (cadr (assoc_string mcep_name trees)))))
                            cg:rfs_f0_models))
                          (length cg:rfs_f0_models)))))
               (track.set param_track i 0 (cadr f0_val))

               ;; MCEP prediction
               (set! frame (wagon mcep (cadr mcep_tree)))
               (if cg:multimodel
                   (set! dframe (wagon mcep (cadr mcep_tree_delta))))
               (set! j 1)
               (set! f (car frame))
               (item.set_feat mcep "clustergen_param_frame" f)
               (if cg:rfs
                   (set! rfs_info
                         (mapcar
                          (lambda (rf_model)
                            (set! frame 
                                  (wagon 
                                        mcep
                                        (cadr (assoc_string 
                                               (item.feat mcep cg_name_feature)
                                               (car rf_model)))))
                            (if cg:rfs_prune_stats
                                (format t "cg_prune %02d_%04d\n"
                                        (car (cddr rf_model)) (car frame)))
                            (list (cadr rf_model) (car frame)))
                          cg:rfs_models)))
               (if cg:multimodel
                   (track.set param_track i 0 
                              (/ (+ (cadr f0_val)
                                    (track.get clustergen_delta_param_vectors 
                                               (car dframe) 0)
                                    (track.get clustergen_param_vectors 
                                               f 0))
                                 3.0)))
               (while (< j num_channels)
                  (cond
                   ((not (null cg:rfs_models))
                    (track.set param_track i j
                     (/
                      (apply +
                       (mapcar 
                        (lambda (rfs_item)
                        (track.get (car rfs_item) (cadr rfs_item)
                                   (* (if cg:mlpg 1 2) j)))
                       rfs_info))
                      (length rfs_info))))
                   ((not (null cg:multimodel))
                      (begin
                        (if (and (boundp 'clustergen_str_mcep_trees)
                                 (> j (* 2 (+ 50)))
                                 (< j 112))
                            (begin
                              (track.set param_track i j
                                 (/
                                  (+
                                   (track.get clustergen_str_param_vectors
                                    (car (wagon mcep (cadr mcep_tree_str)))
                                    (* (if cg:mlpg 1 2) j))
                                   (track.get clustergen_delta_param_vectors
                                    (car dframe) (* (if cg:mlpg 1 2) j))
                                   (track.get clustergen_param_vectors
                                    f (* (if cg:mlpg 1 2) j))
                                   )
                                   3.0)
                                 ))
                            (begin
                              (track.set param_track i j
                                   (/
                                    (+
                                 (track.get clustergen_delta_param_vectors 
                                       (car dframe) (* (if cg:mlpg 1 2) j))
                                 (track.get clustergen_param_vectors 
                                            f (* (if cg:mlpg 1 2) j))
                                 ) 2.0))))
                        ))
                   (t
                    (track.set param_track i j
                               (track.get clustergen_param_vectors 
                                          f (* (if cg:mlpg 1 2) j)))
                    ))
                  (set! j (+ 1 j)))
               (set! j (- num_channels 1))
               (track.set param_track i j
                          (track.get clustergen_param_vectors 
                                     f (* (if cg:mlpg 1 2) j)))
               ))
         
         (track.set_time 
          param_track i 
          (+ cg:initial_frame_offset (* i frame_advance)))
         (set! i (+ 1 i))))
     (utt.relation.items utt 'mcep))

    (if cg:mixed_excitation
        (let ((nf (track.num_frames param_track))
              (f 0) (c 0))
          (set! str_params (track.resize nil nf 5))
          (set! f 0)
          (while (< f nf)
             (track.set_time str_params f (track.get_time param_track f)) 
             (set! c 0)
             (while (< c 5)
              (track.set str_params f c 
                         (track.get param_track f (* (if cg:mlpg 2 1) (+ c 
                                                     (+ 1 (* 2 mcep_length))  ; after all mcep and deltas
                                                     ))))
              (set! c (+ 1 c)))
             (set! f (+ 1 f)))
          (utt.set_feat utt "str_params" str_params)))

    (if cg:F0_interpolate (cg_F0_interpolate utt param_track))

    (if (or cg:vuv cg:with_v)
           ;; need to get rid of the vuv coefficient (last one)
        (let ((nf (track.num_frames param_track))
              (nc (- (track.num_channels param_track) 2))
              (f 0) (c 0))
          (set! nnn_track (track.resize nil nf nc))
          (while (< f nf)
             (track.set_time nnn_track f (track.get_time param_track f)) 
             (set! c 0)
             (while (< c nc)
                (track.set nnn_track f c (track.get param_track f c))
                (set! c (+ 1 c)))
             (set! f (+ 1 f)))
          (set! param_track nnn_track)
          ))

    ;; Post Filter (or cart replacement)
    (if cg:post_filter
        (let ((params_file (make_tmp_filename))
              (feats_file (make_tmp_filename))
              (new_params_file (make_tmp_filename)))
          (format t "in post_filter\n")
          (track.save param_track params_file)
          (set! fffd (fopen feats_file "w"))
          (mapcar
           (lambda (m)
             (mapcar
              (lambda (f)
                (format fffd "%s " (item.feat m f)))
              post_filter_feats)
             (format fffd "\n"))
           (utt.relation.items utt 'mcep))
          (fclose fffd)
          (system 
           (format nil "%s %s %s %s\n"
                   cg:post_filter_script_name
                   params_file
                   feats_file
                   new_params_file))
          (set! new_param_track (track.load new_params_file))
          (utt.set_feat utt "param_track" new_param_track)
          (set! param_track new_param_track)
          (delete-file params_file)
          (delete-file feats_file)
          (delete-file new_params_file)))
    ;; MLPG
    (if cg:mlpg  ;; assume cg:deltas too
          (let ((nf (track.num_frames param_track))
              (nc (* 2 (+ 1 mcep_length mcep_length))) ;; f0 static delta (mean and stddev)
              (f 0) (c 0))
            (if cg:debug (format t "cg:debug calling mlpg\n"))
            (set! nnn_track (track.resize nil nf nc))
            (while (< f nf)
               (track.set_time nnn_track f (track.get_time param_track f)) 
               (set! c 0)
               (while (< c nc)
                  (track.set nnn_track f c (track.get param_track f c))
                  (set! c (+ 1 c)))
               (set! f (+ 1 f)))
            (set! param_track nnn_track)
            (set! new_param_track (cg_do_mlpg param_track))
            (utt.set_feat utt "param_track" new_param_track)
            (set! param_track new_param_track)))
    (if (and (not cg:mlpg) cg:deltas)
        (begin   ;; have to reduce param_track to remove deltas
          (set! new_param_track 
                (track.resize 
                 param_track
                 (track.num_frames param_track)
                 26)) ;; not very portable
          (utt.set_feat utt "param_track" new_param_track)
          (set! param_track new_param_track)))
    
    (if cg:F0_smooth (cg_F0_smooth param_track 0))
    (if cg_predict_unvoiced
        (begin
          (set! i 0)
          (mapcar
           (lambda (frame)
             (if ;(not (ClusterGen_mcep_voiced frame))
                 (not (ClusterGen_voicing_v frame))
                 (track.set param_track i 0 0.0))
             (set! i (+ 1 i)))
           (utt.relation.items utt 'mcep))))
    (if cg:param_smooth
        (mapcar
         (lambda (x) (cg_mcep_smooth param_track x))
         '(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)))
    utt
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; CGV: prediction with viterbi
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cgv_reverse_probs pdf)
  (cond
   ((null pdf) nil)
   ((eq (car (cdr (car pdf))) 0)
    (cgv_reverse_probs (cdr pdf)))
   (t
    (cons 
     (list (car (car pdf))
           (/ (car (cdr (car pdf)))
              (cgv_prob (car (car pdf)))))
     (cgv_reverse_probs (cdr pdf))))))

(define (cgv_prob c)
  (let ((xxx (assoc_string c cgv_class_probs)))
    (if xxx
        (car (cdr xxx))
        0.000012)))

(define (cgv_cand_function s)
;  (format t "cand_function %s\n" (item.name s))
  (let ((mcep_tree (assoc_string (item.name s) clustergen_mcep_trees))
        (probs nil))
    (cond
     ((string-equal "S" (item.name s))
      (set! probs (cgv_reverse_probs '((S 1)))))
     ((string-equal "E" (item.name s))
      (set! probs (cgv_reverse_probs '((E 1)))))
     (mcep_tree
      (set! probs 
            (cgv_reverse_probs (cdr (reverse (wagon s (cadr mcep_tree)))))))
     (t
      (format t "ClusterGen: cgv can't find cluster tree for %s\n"
              (item.name s))
      (set! probs nil)))
;    (format t "%s %l\n" (item.name s) probs)
    probs))

(define (ClusterGen_predict_cgv utt)
  (format t "predict cgv\n")
  (let ((param_track nil)
        (frame_advance cg:frame_shift)
        (frame nil) (f nil) (f0_val)
        (num_channels 
         (/ (track.num_channels clustergen_param_vectors)
            (if cg:mlpg 1 2)))
        (num_frames (utt.feat utt "param_track_num_frames"))
        )

    ;; Predict mcep values
    (set! i 0)
    (set! param_track (track.resize nil num_frames num_channels))
    (utt.set_feat utt "param_track" param_track)

    (utt.relation.create utt 'cseq)
    (set! citem (utt.relation.append utt 'cseq nil))
    (item.set_feat citem 'name 'S)
    (mapcar
     (lambda (m) (set! citem (utt.relation.append utt 'cseq m)))
     (utt.relation.items utt 'mcep))
    (set! citem (utt.relation.append utt 'cseq nil))
    (item.set_feat citem 'name 'E)

    (set! gen_vit_params
	  (list
	   (list 'Relation "cseq")
	   (list 'return_feat "clustergen_class")
	   (list 'p_word "S")
	   (list 'pp_word "S")
;	   (list 'ngramname 'cgv_ngram)
	   (list 'wfstname 'cgv_wfst)
	   (list 'cand_function 'cgv_cand_function)))
    (Gen_Viterbi utt)

    (mapcar
     (lambda (mcep)
       ;; Predict mcep frame
       (let ((f0_tree (assoc_string (item.name mcep) clustergen_f0_trees)))
         (if (null f0_tree)
             (format t "ClusterGen: can't find cluster tree for %s\n"
                     (item.name mcep))
             (begin
               ;; F0 prediction
               (set! f0_val (wagon mcep (cadr f0_tree)))
               (if (eq (cadr f0_val) 0.0)
                   (track.set param_track i 0 0.0)
                   ;; Wave exp() but its worse
                   (track.set param_track i 0 (cadr f0_val)))

               ;; MCEP prediction
               (set! j 1)
               (set! f (parse-number
                        (string-after 
                         (item.feat mcep "clustergen_class")
                         "c")))
               (item.set_feat mcep "clustergen_param_frame" f)
               (while (< j num_channels)
                  (track.set param_track i j 
                    (track.get clustergen_param_vectors 
                               f (* (if cg:mlpg 1 2) j))
                    )
                  (set! j (+ 1 j)))))
         
         (track.set_time 
          param_track i 
          (+ cg:initial_frame_offset (* i frame_advance)))
         (set! i (+ 1 i))))
     (utt.relation.items utt 'mcep))

    ;; MLPG
    (if cg:mlpg  ;; assume cg:deltas too
        (begin
          (if cg:debug (format t "cg:debug calling mlpg\n"))
          (set! new_param_track (cg_do_mlpg param_track))
          (utt.set_feat utt "param_track" new_param_track)
          (set! param_track new_param_track)))
    (if (and (not cg:mlpg) cg:deltas)
        (begin   ;; have to reduce param_track to remove deltas
          (set! new_param_track 
                (track.resize 
                 param_track
                 (track.num_frames param_track)
                 26)) ;; not very portable
          (utt.set_feat utt "param_track" new_param_track)
          (set! param_track new_param_track)))
    
    (if cg:F0_smooth (cg_F0_smooth param_track 0))
    (if cg_predict_unvoiced
        (begin
          (set! i 0)
          (mapcar
           (lambda (frame)
             (if (not (ClusterGen_mcep_voiced frame))
                 (track.set param_track i 0 0.0))
             (set! i (+ 1 i)))
           (utt.relation.items utt 'mcep))))
    (if cg:param_smooth
        (mapcar
         (lambda (x) (cg_mcep_smooth param_track x))
         '(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)))
    utt
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Trajectory prediction functions (including ola)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cg_voiced state)
  "(cg_voiced state)
t if this state is voiced, nil otherwise."
  (if (and cg_predict_unvoiced
           (string-equal "-" (item.feat state "R:segstate.parent.ph_vc"))
           (string-equal "-" (item.feat state "R:segstate.parent.ph_cvox")))
      nil
      t))

(define (ClusterGen_predict_trajectory utt)
  (let ((param_track nil)
        (frame_advance cg:frame_shift)
        (frame nil) (f nil) (f0_val)
        (num_channels 
         (/ (track.num_channels clustergen_param_vectors)
            (if cg:mlpg 1 2)))
        )

    ;; Predict mcep values
    (set! i 0)
    (set! param_track
          (track.resize nil
           (utt.feat utt "param_track_num_frames")
           num_channels))
    (utt.set_feat utt "param_track" param_track)
;    (set! param_track (utt.feat utt "param_track"))
    (mapcar
     (lambda (state)
       ;; Predict mcep frame
;joint       (let ((mcep_tree (assoc_string (item.name state) traj::clustergen_mcep_trees))
       (let ((mcep_tree (assoc_string (item.name state) clustergen_mcep_trees))
             ;(f0_tree (assoc_string (item.name mcep) clustergen_f0_trees))
             )
         (if (null mcep_tree)
             (format t "ClusterGen: can't find cluster tree for %s\n"
                     (item.name state))
             (begin
               ;; feature prediction (F0 and mcep)
               (set! trajectory (wagon state (cadr mcep_tree)))
               (if (item.relation.daughters state 'mcep_link)
                   (begin
                    (if (assoc 'cg::trajectory_ola clustergen_mcep_trees)
;joint                    (if (assoc 'cg::trajectory_ola traj::clustergen_mcep_trees)
                     (cg:add_trajectory_ola
                      (caar trajectory)
                      (cadr (car trajectory))
                      state
                      num_channels
                      param_track
                      frame_advance)
                     (cg:add_trajectory
                      (caar trajectory)
                      (cadr (car trajectory))
                      state
                      num_channels
                      param_track
                      frame_advance))))
               ))))
     (utt.relation.items utt 'HMMstate))

    (if (or cg:vuv cg:with_v)
           ;; need to get rid of the vuv coefficient (last one)
        (let ((nf (track.num_frames param_track))
              (nc (- (track.num_channels param_track) 2))
              (f 0) (c 0))
          (set! full_param_track param_track)
          (set! nnn_track (track.resize nil nf nc))
          (while (< f nf)
             (track.set_time nnn_track f (track.get_time param_track f)) 
             (set! c 0)
             (while (< c nc)
                (track.set nnn_track f c (track.get param_track f c))
                (set! c (+ 1 c)))
             (set! f (+ 1 f)))
          (set! param_track nnn_track)
          ))
    ;; MLPG
    (if cg:mlpg
        (begin
          (if cg:debug (format t "cg:debug calling mlpg\n"))
          (set! new_param_track (cg_do_mlpg param_track))
          (utt.set_feat utt "param_track" new_param_track)
          (set! param_track new_param_track)))

    (if (and (not cg:mlpg) cg:deltas)
        (begin   ;; have to reduce param_track to remove deltas
          (set! new_param_track 
                (track.resize 
                 param_track
                 (track.num_frames param_track)
                 26)) ;; not very portable
          (utt.set_feat utt "param_track" new_param_track)
          (set! param_track new_param_track)))
    (if cg:F0_smooth (cg_F0_smooth param_track 0))
    (if cg_predict_unvoiced
        (begin
          (set! i 0)
          (mapcar
           (lambda (frame)
             (if ;(not (ClusterGen_mcep_voiced frame))
                 (not (ClusterGen_voicing_v_traj frame i full_param_track))
                 (track.set param_track i 0 0.0))
             (set! i (+ 1 i)))
           (utt.relation.items utt 'mcep))))
    (if cg:param_smooth
        (mapcar
         (lambda (x) (cg_mcep_smooth param_track x))
     ;     '(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)
         '( 1 2 3 )
         ))
    utt
  )
)

(define (cg:add_trajectory s_start s_frames state num_channels
                           param_track frame_advance)
"(cg:add_trajectory start n state num_channels)
Add trajectory to daughters of state, interpolating as necessary."
  (let ((j 0) (i 0)
        (mceps (item.relation.daughters state 'mcep_link)))

    (set! t_start (item.feat (car mceps) "frame_number"))
    (set! t_frames (length mceps))
    (set! m (/ (- s_frames 1) t_frames))
    (set! f 0)

    (while (< i t_frames)
       ;; find f
       (set! s_pos (nint (+ s_start f)))

       (track.set param_track (+ i t_start) 0
                  (track.get clustergen_param_vectors s_pos 0))

       (set! j 1)
       (while (< j num_channels)
              (track.set param_track (+ i t_start) j 
;joint               (+ (* 0.35 (track.get param_track (+ i t_start) j))
;                        (* 0.65 (track.get traj::clustergen_param_vectors 
;                                          s_pos (* 2 j)))))
                         (track.get clustergen_param_vectors 
                                    s_pos (* (if cg:mlpg 1 2) j)))
              (set! j (+ 1 j)))
       (set! f (+ m f))
       (track.set_time 
        param_track (+ i t_start) 
        (+ cg:initial_frame_offset (* (+ i t_start) frame_advance)))
       (set! i (+ i 1))
       )
    )
  )

(define (cg:add_trajectory_ola s_start s_frames state num_channels
                           param_track frame_advance)
"(cg:add_trajectory start n state num_channels)
Add trajectory to daughters of state, interpolating as necessary."
  (let ((j 0) (i 0) (s1l 0) (s2l 0) (m 0.0) (w 0.0)
        (t_start 0) (t_frames 0) (s_offset 0)
        (mceps1 nil) (mceps2 nil))

    (set! i 0)
    (while (< i s_frames)
     (if (equal? -1.0 (track.get clustergen_param_vectors (+ s_start i) 0))
         (set! s1l i))
     (set! i (+ i 1)))

    (if (and (item.prev state) 
             (item.relation.daughters (item.prev state) 'mcep_link)
             (> s1l 0))
        (begin ;; do overlap on previous 
          (set! mceps1 (item.relation.daughters (item.prev state) 'mcep_link))
          (set! first_half_delta (/ 1.0 (length mceps1)))
          (set! t_start (item.feat (car mceps1) "frame_number"))
          (set! t_frames (length mceps1))
          (set! m (/ s1l t_frames))
          (set! i 0)
          (set! w 0.0)
          (while (< i t_frames)
           (set! s_offset (nint (* i m)))
           (if (not (< s_offset s1l))
               (begin
;                 (format t "boing pre\n")
                 (set! s_offset (- s1l 1))))
           (set! s_pos (+ s_start s_offset))
           (if (< (track.get clustergen_param_vectors s_pos 0) 0)
               (format t "assigning pre -1/-2 %d %d %f\n" s_pos i m))
           ;; F0 Prediction
           (track.set param_track (+ i t_start) 0
                      (+ (* (- 1.0 w) (track.get param_track (+ i t_start) 0))
                         (* w (track.get clustergen_param_vectors s_pos 0))))

           ;; MCEP Prediction
           (set! j 1)
           (while (< j num_channels)
             (track.set param_track (+ i t_start) j 
              (+ (* (- 1.0 w) (track.get param_track (+ i t_start) j))
                 (* w 
                    (track.get clustergen_param_vectors s_pos 
                               (* (if cg:mlpg 1 2) j))
                    )
                 )
              )
             (set! j (+ 1 j)))
           (set! i (+ 1 i))
           (set! w (+ w first_half_delta))
           (if (> w 1.0) (set! w 1.0))
           )
          ))

    ;; do assignment on current unit 
    (set! mceps2 (item.relation.daughters state 'mcep_link))
    (set! t_start (item.feat (car mceps2) "frame_number"))
    (set! t_frames (length mceps2))
    (set! s2l (- s_frames (+ s1l 2)))
    (set! s2_start (+ s_start s1l 1))
    (set! m (/ s2l t_frames))
    (set! i 0)
    (while (< i t_frames)
     (set! s_offset (nint (* i m)))
     (if (not (< s_offset s2l))
         (set! s_offset (- s2l 1)))
     (set! s_pos (+ s2_start s_offset))
     (if (< (track.get clustergen_param_vectors s_pos 0) 0)
         (format t "assigning -1/-2 %d %d %f %f\n" s_pos i m
                 (track.get clustergen_param_vectors s_pos 0)))
     ;; F0 Prediction
     (track.set param_track (+ i t_start) 0
                (track.get clustergen_param_vectors s_pos 0))
     ;; MCEP Prediction
     (set! j 1)
     (while (< j num_channels)
      (track.set param_track (+ i t_start) j 
                 (track.get clustergen_param_vectors s_pos 
                            (* (if cg:mlpg 1 2) j)))
      (set! j (+ 1 j)))
     (track.set_time 
      param_track (+ i t_start) 
      (+ cg:initial_frame_offset (* (+ i t_start) frame_advance)))
     (set! i (+ 1 i))
    )
  )
)

;;; For ClusterGen_predict_mcep
;;;   take into account actual and delta and try to combine both
;                   (if (and nil (> i 0))
;                       (begin ;; something a little fancier
;                   (set! m1 (track.get cpv f (* 2 j)))         ;; mean1
;                   (set! s1 (track.get cpv f (+ (* 2 j) 1)))   ;; sdev1
;                   (set! m2 (track.get cpv f (+ 26 (* 2 j))))  ;; mean2 (delta)
;                   (set! s2 (track.get cpv f (+ 26 (* 2 j) 1)));; sdev2 (delta)
;                   (set! p1 (track.get param_track (- i 1) j)) ;; p.value

;                   (if (equal? s2 0)
;                       (set! p m1)
;                       (set! p (/ (+ m1 (+ m2 p1)) 2.0))
; ;                      (set! p (/ (+ (/ m1 s1) (/ (+ m2 p1) s2))
; ;                                 (+ (/ 1.0 s1) (/ 1.0 s2))))
;                       )
;                   (track.set param_track i j p)
; ;                  (format t "m1 %f s1 %f m2 %f s2 %f p %f\n"
; ;                          m1 s1 (+ p1 m2) s2 p)
;                   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  For VC adpatation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (build_cg_vc_source datafile)
  (mapcar
   (lambda (x)
     (format t "%s Build source files for VC adaptation\n" (car x))
     (set! utt1 (SynthText (cadr x)))
     (utt.save.wave utt1 (format nil "vc/wav/source/%s.wav" (car x)))
     (track.save (utt.feat utt1 "param_track") "param.track")
     (system (format nil "$FESTVOXDIR/src/vc/scripts/get_f0mcep %s param.track vc\n" (car x)))
     )
   (load datafile t))
  t
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Sort of historical it should be set in INST_LANG_VOX_cg.scm
;; but maybe not in old instantiations
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(defvar cluster_synth_method 
;  (if (boundp 'mlsa_resynthesis)
;      cg_wave_synth
;      cg_wave_synth_external ))

; (require 'hsm_cg)

(define (cg_wave_synth_deltas utt)
  ;; before we had it built-in to Festival
  (let ((trackname (make_tmp_filename))
        (wavename (make_tmp_filename))
        )
    (track.save (utt.feat utt "param_track") trackname "est")
    (system
     (format nil "$FESTVOXDIR/src/clustergen/cg_resynth_deltas %s %s"
             trackname wavename))
    (utt.import.wave utt wavename)
    (delete-file trackname)
    (delete-file wavename)
    utt)
)
(set! cluster_synth_method cg_wave_synth)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'clustergen)
