source: tol/tolbaseBLT/lib/toltk/corgraph.tcl

devel
Last change on this file was 56ade3b, checked in by Jorge Pérez <josp.jorge@…>, 10 years ago

fixes #1932, se ha creado la rama trunk/tolbaseBLT copia de trunk/tolbase

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7330 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 17.3 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : corgraph.tcl
3# PURPOSE : This file
4#           It's a child of bayesGraph so inherites all its functionalities.
5#/////////////////////////////////////////////////////////////////////////////
6
7
8#/////////////////////////////////////////////////////////////////////////////
9namespace eval AutocorGraph {
10# 
11#///////////////////////////////////////////////////////////////////////////// 
12  variable tmpOpt
13}
14
15
16#///////////////////////////////////////////////////////////////////////////// 
17proc ::AutocorGraph::Create { path serie } {
18# 
19#/////////////////////////////////////////////////////////////////////////////   
20  global toltk_images_path
21  global zoomInfo
22#puts "Create ..... path: $path \n serie: $serie"
23  set structure {v {h g g} {h g g}}
24  set Instance [::bayesGraph::Create $path $structure]
25  upvar \#0 ${Instance}::widgets widgets
26  upvar \#0 ${Instance}::data data
27
28  set data(namespace) AutocorGraph
29  set data(proc,OnOptionCreate)   ::AutocorGraph::OptionsCreate
30  set data(proc,OnOptionDestroy)  ::AutocorGraph::OptionsDestroy
31  set data(proc,OnOptionApply)    ::AutocorGraph::OptionsApply
32  set data(proc,OnComputeStepX)   ::AutocorGraph::ComputeStepX
33  set data(proc,OnFixStepX)       ::AutocorGraph::FixStepX
34  set data(proc,OnEvalWindow)     ::AutocorGraph::EvalWindow
35  set data(proc,OnToTable)        ::AutocorGraph::ToTable
36  set data(proc,OnWriteIni)       ::AutocorGraph::WriteIni
37
38  # se configuran los valores de inicio
39  set data(typecor) {{ACF "Autocorrelation"} \
40                     {PACF "Partial Autocorrelation"} \
41                     {IACF "Inverse Autocorrelation"} \
42                     {IPACF "Inverse partial Autocorrelation"}}
43  set data(serie) $serie
44
45  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
46    set grpath $widgets(gr,$gr)
47    set data(gr,active) $gr
48    set data(gr,$gr,title) [lindex [lindex $data(typecor) $gr] 1]
49    set data(gr,$gr,type)  [lindex [lindex $data(typecor) $gr] 0]
50    $grpath bar create serie -relief solid -label $data(gr,$gr,title)
51    set data(gr,$gr,elements) serie
52    bind [winfo toplevel $widgets(this)] <F[expr $gr+2]> +[list ::AutocorGraph::Maximize $Instance [expr $gr+1]]
53
54    set data(gr,$gr,OnGetXTicks)    ::AutocorGraph::GetXValues
55    set data(gr,$gr,OnGetXValues)   ::AutocorGraph::GetXValues 
56  }
57
58  ::bayesGraph::BindLegend $Instance
59  bind [winfo toplevel $widgets(this)] <Escape> [list ::AutocorGraph::Restore $Instance]
60  set data(gr,active) 0
61  #Establecer el fichero GCF del que se lee
62  ::bayesGraph::LoadGCF $Instance
63  ReadIni $Instance
64  Configure $Instance
65
66  return $Instance
67}
68
69
70#///////////////////////////////////////////////////////////////////////////// 
71proc ::AutocorGraph::Maximize {this num} {
72# 
73#/////////////////////////////////////////////////////////////////////////////   
74  #Tolcon_Trace "Maximize this=$this, num=$num"
75  #Hacerlo general, no solo para 4 gráficos
76  upvar \#0 ${this}::widgets widgets
77  switch -- $num {
78    1 {
79       set where1 max
80       set w2 [lindex $widgets(pws) 1]
81       set where2 max}
82    2 {
83       set where1 max
84       set w2 [lindex $widgets(pws) 1]
85       set where2 min}
86    3 {
87       set where1 min
88       set w2 [lindex $widgets(pws) 2]
89       set where2 max}
90    4 {
91       set where1 min
92       set w2 [lindex $widgets(pws) 2]
93       set where2 min
94      }
95  }
96  ::PanedWindow::MoveSash [lindex $widgets(pws) 0] 1 x $where1
97  ::PanedWindow::MoveSash $w2 1 y $where2
98}
99
100
101#///////////////////////////////////////////////////////////////////////////// 
102proc ::AutocorGraph::Restore {this} {
103# 
104#/////////////////////////////////////////////////////////////////////////////   
105  upvar \#0 ${this}::widgets widgets
106  ::PanedWindow::MoveSash [lindex $widgets(pws) 0] 1 x middle
107  ::PanedWindow::MoveSash [lindex $widgets(pws) 1] 1 y middle
108  ::PanedWindow::MoveSash [lindex $widgets(pws) 2] 1 y middle
109}
110
111
112#///////////////////////////////////////////////////////////////////////////// 
113proc ::AutocorGraph::Configure {this} {
114# 
115#/////////////////////////////////////////////////////////////////////////////   
116  upvar \#0 ${this}::widgets widgets
117  upvar \#0 ${this}::data data
118  upvar \#0 ${this}::options opt 
119
120  set old_active $data(gr,active)
121  for {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
122    set grpath $widgets(gr,$gr)
123    set data(gr,active) $gr
124    OptionsApplyNLags $this $opt(nLag)
125  }
126  set data(gr,active) $old_active
127  ::bayesGraph::Configure $this
128  for {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
129    set grpath $widgets(gr,$gr)
130    set data(gr,active) $gr
131    OptionsApplyNSigmas $this $opt(nSigmas)
132  }
133  set data(gr,active) $old_active
134}
135
136
137#///////////////////////////////////////////////////////////////////////////// 
138proc ::AutocorGraph::DestroyMarker { this } {
139# 
140#/////////////////////////////////////////////////////////////////////////////   
141  upvar \#0 ${this}::options opt
142  set grpath [::bayesGraph::getActiveGraph $this]
143  if { [info exist opt(markers)] } {
144    if {[llength $opt(markers)] > 0} {
145      foreach item $opt(markers) {
146        $grpath marker delete $item
147      }
148    }
149  }
150}
151
152
153#///////////////////////////////////////////////////////////////////////////// 
154proc ::AutocorGraph::GetXValues {this} {
155# 
156#/////////////////////////////////////////////////////////////////////////////   
157  upvar \#0 ${this}::widgets widgets
158  upvar \#0 ${this}::data data
159  set gr $data(gr,active)
160  set grpath $widgets(gr,$gr)
161  set values [$grpath element cget serie -xdata]
162  #Tolcon_Trace "AutocorGraph::GetXValues: values: $values"
163  return $values
164}
165
166
167#///////////////////////////////////////////////////////////////////////////// 
168proc ::AutocorGraph::ComputeStepX {this min max total} {
169# 
170#/////////////////////////////////////////////////////////////////////////////   
171  #Tolcon_Trace "min: $min; max: $max; total: $total"
172  set dif [expr $max - $min]
173  if {$total > $dif} {
174    set step 1
175  } else {
176    set step [expr round($dif/$total)]
177  }
178  return $step
179}
180
181
182#///////////////////////////////////////////////////////////////////////////// 
183proc ::AutocorGraph::FixStepX {this min max step} {
184# 
185#/////////////////////////////////////////////////////////////////////////////   
186  upvar \#0 ${this}::data data
187  if {[string length $max] && [string length $min]} {
188    set dif [expr $max - $min]
189    if {$step > $dif } {
190      set step [expr round($dif)]
191    } else {
192      set step [expr round($step)]
193    }
194  } else {
195    set step [expr round($step)]
196  }
197  return $step
198}
199
200
201#///////////////////////////////////////////////////////////////////////////// 
202proc ::AutocorGraph::EvalWindow {this} {
203#
204#/////////////////////////////////////////////////////////////////////////////   
205  upvar \#0 ${this}::data data
206  set serie $data(serie)
207  if {[llength $serie] > 1} {
208    set nameSerie [lindex [::tol::info variable $serie] 1]
209  } else {
210    set nameSerie $serie
211  }
212  return $nameSerie
213}
214
215
216#///////////////////////////////////////////////////////////////////////////// 
217proc ::AutocorGraph::ToTable {this} {
218#
219#///////////////////////////////////////////////////////////////////////////// 
220  upvar \#0 ${this}::data data
221  upvar \#0 ${this}::options opt
222  upvar \#0 ${this}::widgets widgets
223  set grpath [::bayesGraph::getActiveGraph $this]
224  set tl .tbl_from_$data(serie)
225#  set tl $widgets(this)_table
226  if [winfo exists $tl] {
227    raise $tl
228  } else  {
229    # title
230    if {[llength $data(serie)] > 1} {
231      set nameSerie [lindex [::tol::info variable $data(serie)] 1]
232    } else {
233      set nameSerie $data(serie)
234    }
235    # create
236    set tl [::project::CreateForm \
237      -title "[mc "Autocorrelation table"]: $nameSerie" \
238      -iniconfig AutocorGraphTable \
239      -type Tables
240    ]
241        set tlf [$tl getframe]
242    # config
243    btable $tlf.t -parent $tl \
244                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
245                  -iniconfig btable
246    $tlf.t fillAutocor $data(serie) ""
247    $tl bind <Control-F4> [list $tl kill]
248    pack $tlf.t -fill both -expand yes
249  }
250}
251
252
253#/////////////////////////////////////////////////////////////////////////////
254  proc ::AutocorGraph::OptionsCreate {this ts} {
255#
256# PURPOSE: Creates especific options of a autocorrelation graph. It's called
257#          by BayesGraph when general graph options are created.
258#
259# PARAMETERS:
260#   this -> Instance of BayesTable
261#   ts   -> tabset in which options must be created
262#
263#/////////////////////////////////////////////////////////////////////////////
264  ReadIniOpc $this
265  #insertar tabset
266  $ts insert end Autocorrelation
267  set f [frame $ts.f1]
268  $ts tab configure "Autocorrelation" -text [mc "Autocorrelation"]\
269      -window $f -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
270
271  set w_tabset [::blt::tabset $f.ts -relief flat -highlightthickness 0\
272                        -bd 0 -outerpad 0 -tier 2 -slant right -textside right]
273  $w_tabset insert end Parameters
274
275  set f1 [frame $w_tabset.f1]
276 
277  $w_tabset tab configure "Parameters" -text [mc "Parameters"]\
278    -window $f1 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
279 
280  OptionsGet $this
281  OptionsCreateParameters $this $f1
282 
283  #OptionsInit  $this
284  #OptionsSet   $this
285 
286  grid $w_tabset -sticky news 
287  grid rowconfigure    $f 0 -weight 1
288  grid columnconfigure $f 0 -weight 1
289}
290
291
292#/////////////////////////////////////////////////////////////////////////////
293proc ::AutocorGraph::OptionsCreateParameters {this w} {
294#
295#///////////////////////////////////////////////////////////////////////////// 
296  upvar \#0 ${this}::options opt
297  variable tmpOpt
298  TitleFrame $w.tf1 -text [mc "Parameters"]
299  set f1 [$w.tf1 getframe]
300  label $f1.lnLags -text [mc "Numbers of lags"]:
301  SpinBox $f1.sbnLags -width 8 -justify right -editable 1 -range "0 500" \
302    -textvariable ::AutocorGraph::tmpOpt(var,nLag)
303  label $f1.lnSigma -text [mc "Sigma factor"]:
304  set tmpOpt(widget,comboSigma) [::Objects::ComboAutoFillCreate $f1.cbnSigma \
305    -width 7 -height 5 -editable 1 -justify right \
306    -values $opt(listSigmas) \
307    -textvariable ::AutocorGraph::tmpOpt(var,nSigmas)]
308  label $f1.lSigma -text [mc "Sigma value"]:
309  label $f1.lvSigma -text $tmpOpt(var,valueSigma)
310  frame $f1.f -width 20
311  grid $f1.f $f1.lnLags  $f1.sbnLags  -sticky w -pady 2
312  grid ^     $f1.lnSigma $f1.cbnSigma -sticky w -pady 2
313  grid ^     $f1.lSigma  $f1.lvSigma  -sticky w -pady 2
314  grid rowconfigure    $f1 3 -weight 1
315  grid columnconfigure $f1 2 -weight 1
316  grid $w.tf1 -sticky news -padx 2
317  grid rowconfigure    $w 0 -weight 1
318  grid columnconfigure $w 0 -weight 1
319} 
320
321#/////////////////////////////////////////////////////////////////////////////
322  proc ::AutocorGraph::OptionsDestroy {this} {
323#
324# PURPOSE: Called before options dialog is destroyed. This procedure is called
325#          by parent BayesGraph. Actually writes to ini file options dialog's
326#          options.
327#
328# PARAMETERS:
329#   this -> Instance of BayesGraph
330#
331#/////////////////////////////////////////////////////////////////////////////
332  ::AutocorGraph::WriteIniOpc $this
333}
334
335
336#/////////////////////////////////////////////////////////////////////////////
337  proc ::AutocorGraph::OptionsGet {this} {
338#
339# PURPOSE: Initializes all options variables and stores them into the
340#          temporary 'tmpOpt' array.
341#
342# PARAMETERS:
343#   this   -> Instance of BayesGraph
344#
345#/////////////////////////////////////////////////////////////////////////////
346  upvar \#0 ${this}::data data
347  upvar \#0 ${this}::options opt
348  variable tmpOpt
349
350  set tmpOpt(var,nLag)       $opt(nLag)
351  set tmpOpt(var,nSigmas)    $opt(nSigmas)
352  set tmpOpt(var,listSigmas) $opt(listSigmas)
353  set tmpOpt(var,valueSigma) $data(valueSigma)
354}
355
356
357#/////////////////////////////////////////////////////////////////////////////
358  proc ::AutocorGraph::OptionsSet {this} {
359#
360# PURPOSE: Commits all options values from the temporary 'tmpOpt' array to
361#          other structure.
362#
363# PARAMETERS:
364#   this   -> Instance of BayesGraph
365#
366#/////////////////////////////////////////////////////////////////////////////
367  upvar  \#0 ${this}::options opt
368
369  variable tmpOpt
370  set opt(nLag)       $tmpOpt(var,nLag)
371  set opt(nSigmas)    $tmpOpt(var,nSigmas)
372  set opt(listSigmas) $tmpOpt(var,listSigmas)
373}
374
375
376#/////////////////////////////////////////////////////////////////////////////
377proc ::AutocorGraph::OptionsApply {this} {
378#
379#///////////////////////////////////////////////////////////////////////////// 
380  variable tmpOpt 
381  upvar \#0 ${this}::widgets widgets
382  upvar \#0 ${this}::data data
383  upvar \#0 ${this}::options opt 
384
385  OptionsApplyNLags   $this $tmpOpt(var,nLag)
386  OptionsApplyNSigmas $this $tmpOpt(var,nSigmas)
387
388  ::bayesGraph::GrapOptCheckXYAxisAll $this
389  ::bayesGraph::GrapOptApplyAxisPos $this ::bayesGraph::tmpOpt var
390  OptionsSet $this
391}
392
393
394#/////////////////////////////////////////////////////////////////////////////
395proc ::AutocorGraph::OptionsApplyNLags { this nLag} {
396#
397#///////////////////////////////////////////////////////////////////////////// 
398  upvar \#0 ${this}::widgets widgets
399  upvar \#0 ${this}::data data
400  upvar \#0 ${this}::options opt
401  set gr $data(gr,active)
402  set grpath $widgets(gr,$gr)
403  #read values from TOL
404  set values [::tol::autocor $data(gr,$gr,type) $data(serie) $nLag]
405  set data(valueSigma) [lindex $values 2]
406  for {set i 1} {$i <= $nLag} {incr i 1} {
407    lappend  lvalues $i.0 [lindex [lindex $values 3] [expr $i-1]]
408    }
409  $grpath bar configure serie -data $lvalues
410  # Limits & Axis...
411  set data(gr,$gr,limitsY) [$grpath axis limits y]
412  set a_miny  [expr abs([lindex $data(gr,$gr,limitsY) 0])]
413  set a_maxy  [expr abs([lindex $data(gr,$gr,limitsY) 1])]
414  if { [expr $a_miny-$a_maxy] > 0 } {
415    set bound $a_miny
416  } else {
417    set bound $a_maxy
418  }
419  if {[expr $bound-(3*$data(valueSigma))] < 0 } {
420    set bound [expr 3*$data(valueSigma)]
421  }
422  ::bayesGraph::GrapOptApplyAxisLimits $this x 1              $nLag
423  ::bayesGraph::GrapOptApplyAxisLimits $this y [expr -$bound] $bound
424}
425
426
427#/////////////////////////////////////////////////////////////////////////////
428proc ::AutocorGraph::OptionsApplyNSigmas { this nSigmas} {
429#
430#///////////////////////////////////////////////////////////////////////////// 
431  global toltk_images_path
432  upvar \#0 ${this}::widgets widgets
433  upvar \#0 ${this}::data data
434  upvar \#0 ${this}::options opt
435  set gr $data(gr,active)
436  set grpath $widgets(gr,$gr)
437  #DestroyMarker $this
438 
439  set posSig [expr $nSigmas * $data(valueSigma)]
440  $grpath marker create polygon -name sigmaPos -under yes\
441    -coords {-Inf  $posSig Inf $posSig Inf Inf -Inf Inf}\
442    -stipple @[file join $toltk_images_path fill.xbm]
443  $grpath marker create polygon -name sigmaNeg -under yes\
444    -coords {-Inf  -$posSig Inf -$posSig Inf -Inf -Inf -Inf}\
445    -stipple @[file join $toltk_images_path fill.xbm]
446  $grpath marker create line -name sigmaPosL -outline red -linewidth 2\
447    -coords {-Inf  $posSig Inf $posSig}
448  $grpath marker create line -name sigmaNegL -outline red -linewidth 2\
449    -coords {-Inf  -$posSig Inf -$posSig}
450    $grpath marker create text -name mtextd -coords {Inf $posSig}  -fill "" -outline red\
451    -anchor ne -text "${nSigmas}*Sigma"
452  $grpath marker create text -name mtexti -coords {Inf -$posSig} -fill "" -outline red\
453    -anchor se -text "-${nSigmas}*Sigma"
454  $grpath marker create line -name ejeX -coords {-Inf 0 Inf 0} -dashes {2 1 1 1}
455  $grpath marker create line -name ejeY -coords {0 -Inf 0 Inf} -dashes {2 1 1 1}
456  set opt(markers) { sigmaPos sigmaNeg sigmaPosL sigmaNegL mtextd mtexti }
457}
458
459
460#/////////////////////////////////////////////////////////////////////////////
461  proc ::AutocorGraph::ReadIni {this} {
462#
463# PURPOSE: Reads autocor graph specific options from .ini file. First of all,
464#          reads options from BayesGraph. Ini file is the active graphic
465#          configuration file.
466#
467# PARAMETERS:
468#   this  -> Instance of BayesGraph
469#
470#/////////////////////////////////////////////////////////////////////////////
471  upvar \#0 ${this}::data data
472  upvar \#0 ${this}::options opt
473  #set rini ::iniFile::Read
474  set rini ::iniFile::ReadGCF
475
476  set opt(nSigmas)     [$rini AutocorGraph nSigmas 2]
477  set opt(nLag)        [$rini AutocorGraph nLag 30]
478  ::bayesGraph::ReadIni $this
479}
480
481
482#/////////////////////////////////////////////////////////////////////////////
483  proc ::AutocorGraph::WriteIni {this} {
484#
485# PURPOSE: Writes autocor graph specific options to .ini file. This procedure
486#          is called by parent BayesGraph. Ini file is the active graphic
487#          configuration file.
488#
489# PARAMETERS:
490#   this  -> Instance of BayesGraph
491#
492#/////////////////////////////////////////////////////////////////////////////
493  upvar \#0 ${this}::data data
494  upvar \#0 ${this}::widgets widgets
495  upvar \#0 ${this}::options opt
496  #set wini ::iniFile::Write
497  set wini ::iniFile::WriteGCF
498
499  $wini AutocorGraph nSigmas  $opt(nSigmas)
500  $wini AutocorGraph nLag     $opt(nLag)
501}
502
503
504#/////////////////////////////////////////////////////////////////////////////
505proc ::AutocorGraph::ReadIniOpc {this} {
506#
507#///////////////////////////////////////////////////////////////////////////// 
508  upvar \#0 ${this}::data data
509  upvar \#0 ${this}::options opt
510  set rini ::iniFile::Read
511  set opt(listSigmas) [$rini AutocorGraphOpc listSigmas {1 2 3}]
512}
513
514
515#/////////////////////////////////////////////////////////////////////////////
516proc ::AutocorGraph::WriteIniOpc {this} {
517#
518#///////////////////////////////////////////////////////////////////////////// 
519  upvar \#0 ${this}::data data
520  upvar \#0 ${this}::options opt
521  variable tmpOpt
522  set wini ::iniFile::Write
523  $wini AutocorGraphOpc listSigmas [${tmpOpt(widget,comboSigma)} cget -values]
524}
Note: See TracBrowser for help on using the repository browser.