#
# User Interface for the ssa command.
#
# SSA performs singular spectrum analysis on a time series.
# See the ssa man page for more information.
#
# $Id: ssa.tcl,v 1.3 1994/04/09 00:49:00 weibel Exp weibel $
#


proc gui_ssa {infile}  { 
    global viz carlo ssa
    
    catch {destroy .ssa}
    toplevel .ssa -relief raised -bd 2

    label .ssa.l -text "Singular Spectrum Analysis" -bd 10
    frame .ssa.b -bd 2
    frame .ssa.c -bd 5
    frame .ssa.log -bd 6
    frame .ssa.f
    frame .ssa.bot

#    pack append .ssa .ssa.l top .ssa.c top .ssa.b top .ssa.log {padx 20 fill} .ssa.f fill .ssa.bot expand
    pack .ssa.l .ssa.c .ssa.b .ssa.log .ssa.f .ssa.bot

    # Display Options
    button .ssa.b.var -relief raised -text "Variance" -command variance
    button .ssa.b.eof -relief raised -text "T-EOFs" -padx 10 -command showEOF
    button .ssa.b.tpc -relief raised -text "T-PCs"  -padx 10 -command showPC
    button .ssa.b.fts -relief raised -text "Filtered RCs" -command {showRC $datadir/$infile}
    pack .ssa.b.var .ssa.b.eof .ssa.b.tpc .ssa.b.fts -side left -expand 1

    # Status report
    label .ssa.log.l -relief flat  -height 1 -textvariable ssa(stat)
    pack append .ssa.log .ssa.log.l {left fill}

# SSA parameters
    scan [get_dims $infile] %d d1
    scalentry .ssa.c.w -variable ssa(wlength) -label "Window Length" -from 0 -to [expr $d1/2] -length 250
    scalentry .ssa.c.s  -variable  ssa(nsig)  -label "# of Significant Components" -from 0 -to [expr $d1/10] -length 250
    pack .ssa.c.w .ssa.c.s -side top -pady 1m

#
# Actions and miscellaneous options 
    pack append .ssa.f \
	[mkRadioPanel .ssa.f.c "Covariance" {Burg ssa(cov) { }} {{Vautard et al.} ssa(cov) {-cov2}} {{Broomhead & King} ssa(cov) {-cov3}}] {right expand frame n} \
        [frame .ssa.f.p -bd  5] {left expand frame w} \
	[mkRadioPanel .ssa.f.e {Error Bars} {{Ghil & Mo} ssa(err) { }} {{Vautard & Ghil} ssa(err) -err2} {{Inverse lag-one} ssa(err) -err3}] {left expand frame w}
    .ssa.f.e.b2 configure -command {Err3Scale .ssa.f.e.s -from 100 -to 200}
    
    pack append .ssa.f.p \
	[label .ssa.f.p.title -text "Pairing Criteria"] {frame w} \
        [checkbutton .ssa.f.p.c1 -text "same frequency" -variable ssa(c1) \
	 -relief flat -onvalue " -c1 " -offvalue "" ] \
	{top pady 1m padx 4 frame w} \
        [checkbutton .ssa.f.p.c2 -text "strong fft" -variable ssa(c2) \
	 -relief flat -onvalue " -c2 " -offvalue "" ] \
	{top pady 1m padx 4 frame w} \
        [checkbutton .ssa.f.p.tr -text "do trend test" -variable ssa(tr) \
	 -relief flat -onvalue "-t" -offvalue "" ] \
	{top pady 3m padx 4 frame w} 
    mkOkSave .ssa.bot.r ssa {do_ssa $datadir/$infile} {Save MEM Spectrum as ...} {SaveSSAas [file tail $infile]} SaveSSA
    button .ssa.bot.car -relief raised -text {Monte Carlo Test...} -state disabled -command gui_carlo
    pack .ssa.bot.car .ssa.bot.r -padx 5m -pady 2m -side left

# Pick some practical parameter values 
# Launch ssa, if that's the users default action.
    .ssa.c.w set [expr $d1/12]
    .ssa.c.s set 8
    .ssa.f.p.c1 select
    set ssa(err) { }
    set ssa(cov) {-cov2}
    set carlo(ssatog) 1                    ;   set carlo(wol) 0
    if ($ssa(launch)) {.ssa.bot.r.ok invoke}

# Clean up your room before you go
    bind .ssa <Destroy> {catch {eval exec rm [glob test_{ctr,eofs,ev,pcs,pct,rc}.out] test_ev.out.tmp}}
}


proc do_ssa {infile} {
    global viz vp env ssa
    set ssa(stat) "Working..."  ;  Reverse .ssa.log.l ;  update
    set error $ssa(err)
    case $ssa(err) in -err3 {lappend error [expr $ssa(cfac)/100.]}
    catch {eval exec ssa $infile -s $ssa(nsig) -w $ssa(wlength) -v $ssa(c1) $ssa(c2) $ssa(tr) $ssa(cov) $error} msg
    set ssa(stat) Done  ;  Reverse .ssa.log.l  ; update
    exec echo $msg >> spectra.log
    if {![info exists ssa(ev_win_p)]} {
        set ssa(ev_win_p) [window_$viz "Eigenvalue Spectrum"]
    }
    plot_$viz $ssa(ev_win_p) linear-log {test_ev.out xydydy curve}
    .ssa.bot.car configure -state normal
}



proc variance {} {
global viz ssa
    if {![info exists ssa(var_win_p)]} {
        set ssa(var_win_p) [window_$viz "Variance Spectrum"]
    }
    plot_$viz $ssa(var_win_p) linear-log {test_pct.out xy scatter}
}

proc showEOF {} {
global viz ssa
    if {![info exists ssa(eof_win_p)]} {
        set ssa(eof_win_p) [window_$viz "Empirical Orthogonal Functions" 800x450]
    }
    plot_$viz $ssa(eof_win_p) linear {test_eofs.out xy1y2... curve}
}



proc showPC {} {
global viz ssa
    if {![info exists ssa(pc_win_p)]} {
        set ssa(pc_win_p) [window_$viz "Principal components" 800x450]
    }
    plot_$viz $ssa(pc_win_p) linear {test_pcs.out xy1y2... curve}
}


proc showRC {infile} {
    global viz ssa
    if {![info exists ssa(clist)]} {set ssa(clist) {1 2 3 4}}
    set tmp [EntryDialog "Components for reconstruction" $ssa(clist) \
        RClist]
    if {$tmp == ""} { return }
    set ssa(stat) "Working..."    ; Reverse .ssa.log.l ; update
    set ssa(clist) $tmp
    #
    # place commas between list elements, 
    # for the benefit of ssa, which uses a fortran internal read string parsing
    regsub -all (\t|,) $ssa(clist) { } tmp
    regsub -all { +} [string trim $tmp] , tmp
    set d [get_dims test_ev.out] ; set ssa(wlength) [lindex $d 0]
    catch {eval exec ssa $infile -s $ssa(nsig) -w $ssa(wlength) -v $ssa(cov) -sel [list $tmp]} msg
    exec echo $msg >> spectra.log
    if {![info exists ssa(rc_win_p)]} {
        set ssa(rc_win_p) [window_$viz "Sum of Reconstructed Components"]
    }
    set ssa(stat) Done ; Reverse .ssa.log.l
    plot_$viz $ssa(rc_win_p) linear [list test_rc.out y curve "Sum of RC's $ssa(clist)"]
}



#
# SaveSsaAs - make a dialog box to save ssa output 
#
# arguments:
#          prefix -- default prefix to use for naming outfiles
#
proc SaveSSAas {{prefix ssa}} {
    global buf ssa
    
    # prepare the file handling variables
    if {![info exists ssa(savedir)]} {set ssa(savedir) [pwd]}
    foreach b {ctr ev pct eofs pcs rc pair} {
        set ssa(tmp_$b)  test_$b.out
	if {![info exists ssa(save_$b)]} {set ssa(save_$b) ${prefix}_$b.out}
	set buf($b) $ssa(save_$b)
    }

    # open toplevel window and its slave widgets
    set w .ssa.save
    toplevel $w
    wm title $w {Save SSA Results}

    pack [label $w.ld -text {In directory:}] \
	[entry $w.ed -relief sunken -width 40 -textvariable ssa(savedir)] \
	-side top -anchor w  -padx 4m -pady 1m
    pack [frame $w.l] [frame $w.r] -side left -padx 2m -pady 2m

    label $w.tl -text Save

    label $w.tr -text As...
    checkbutton $w.l1 -text {Centered series} -relief flat -variable out(ctr)
    entry $w.e1 -relief sunken -textvariable ssa(save_ctr)
    checkbutton $w.l2 -text {Eigenvalues} -relief flat -variable out(ev)
    entry $w.e2 -relief sunken -textvariable ssa(save_ev)
    checkbutton $w.l3 -text {Percentage of Variance} -relief flat -variable out(pct)
    entry $w.e3 -relief sunken -textvariable ssa(save_pct)
    checkbutton $w.l4 -text {Empirical Orthogonal Functions} -relief flat \
	-variable out(eofs)
    entry $w.e4 -relief sunken -textvariable ssa(save_eofs)
    checkbutton $w.l5 -relief flat -text {Principal Components} -variable out(pcs)
    entry $w.e5 -relief sunken -textvariable ssa(save_pcs)
    checkbutton $w.l6 -relief flat -text {Reconstructed Components} -variable out(rc)
    entry $w.e6 -relief sunken -textvariable ssa(save_rc)
    #checkbutton $w.l7 -relief flat -text {Pairing Test} -variable out(pair)
    #entry $w.e7 -relief sunken -textvariable ssa(save_pair)

# Display the dialog box
    pack $w.tl $w.l1 $w.l2 $w.l3 $w.l4 $w.l5 $w.l6 -in $w.l \
	-side top -anchor w -pady 1m
    pack $w.tr $w.e1 $w.e2 $w.e3 $w.e4 $w.e5 $w.e6 -in $w.r \
	-side top -anchor w -pady 1m

    pack [label $w.p -text Prefix] -in $w.l -anchor e -pady 3m
    pack [entry $w.pe -width 15 -relief sunken -textvariable prefix] \
	-in $w.r -anchor w -pady 3m
    bind $w.pe <Return> {foreach b {ctr ev pct eofs pcs rc pair} {set ssa(save_$b) ${prefix}_$b.out}}
#
# Allow the user to scroll through entries by means of the Tab key
#
    SetTabbing $w.ed $w.e1 $w.e2 $w.e3 $w.e4 $w.e5 $w.e6 

#
# Ultimate action buttons
    mkButton $w.ok OK "SaveSSA ; destroy $w"
    mkButton $w.cancel Cancel {
	foreach b {ctr ev pct eofs pcs rc pair} {set ssa(save_$b) $buf($b)}
	destroy .ssa.save
    }
    pack $w.ok $w.cancel  -pady 2m -padx 4m

#
# grab ownership of the mouse and keyboard, 
# so only this dialog box is active until it dies
    focus $w
    grab $w
}


proc SaveSSA {} {
    global out ssa
    foreach b {ctr ev pct eofs pcs rc} {
	if ($out($b)) {
	    exec cp $ssa(tmp_$b) $ssa(savedir)/$ssa(save_$b)} 
    }
}


#
# A scale widget for the inverse-lag-one error bar option
#
proc Err3Scale {path args} {
    global ssa
    toplevel $path -bd 2m
    wm title $path {Error bar weights}
    eval scale $path.s {-command {set ssa(cfac)}} $args
    button $path.done -text DONE -command "destroy $path" -padx 2m -pady 1m
    message $path.m  -bd 2m \
	-text {  Error bars will be calculated from the inverse of the lag-one AR coefficient.  This slider sets an adjustment factor.  Low values nudge the result towards the errors that would be estimated by Vautard & Ghil.  High values give a result that is closer to Ghil & Mo.   }
    pack $path.done -side bottom -expand 1
    pack $path.s -side left -expand 1
    pack $path.m -side top -expand 1
    if [info exists ssa(cfac)] {$path.s set $ssa(cfac)}
}