source: tol/tolbase/lib/toltk/corgraph.tcl @ a762e01

1941-docker-image-to-testdevel
Last change on this file since a762e01 was e933fd6, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Se sustituyen los ::blt::tabset por NoteBook de BWidget. En total se sustituyeron 19 tabsets.
Se suspenden un par de widgets que parece que no se usan, y por tanto tampoco se les ha sustituido ::blt::tabset: bsersel, btab. bchilddetail tampoco parece usarse.
Se corrige un problem en InsertItem de tolinspe.

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

  • Property mode set to 100644
File size: 17.5 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 (=>NoteBook) in which options must be created
262#
263#/////////////////////////////////////////////////////////////////////////////
264  ReadIniOpc $this
265  #insertar tabset
266  set num_i 1
267  set lab_i Autocorrelation
268  $ts insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
269  set tab_i [$ts getframe $lab_i]
270  $tab_i configure -borderwidth 2 -background \#d9d9d9 
271  set f [frame $tab_i.f]
272  pack $tab_i.f -fill both -expand yes
273   
274  set w_tabset [NoteBook $f.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
275  set num_i 0
276  set lab_i Parameters
277  $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
278  set tab_i [$w_tabset getframe $lab_i]
279  $tab_i configure -borderwidth 2 -background \#d9d9d9
280  set f1 [frame $tab_i.f]
281  pack $tab_i.f -fill both -expand yes 
282  $w_tabset raise [$w_tabset pages 0]
283 
284  OptionsGet $this
285  OptionsCreateParameters $this $f1
286 
287  #OptionsInit  $this
288  #OptionsSet   $this
289 
290  $w_tabset compute_size
291  grid $w_tabset -sticky news 
292  grid rowconfigure    $f 0 -weight 1
293  grid columnconfigure $f 0 -weight 1
294}
295
296
297#/////////////////////////////////////////////////////////////////////////////
298proc ::AutocorGraph::OptionsCreateParameters {this w} {
299#
300#///////////////////////////////////////////////////////////////////////////// 
301  upvar \#0 ${this}::options opt
302  variable tmpOpt
303  TitleFrame $w.tf1 -text [mc "Parameters"]
304  set f1 [$w.tf1 getframe]
305  label $f1.lnLags -text [mc "Numbers of lags"]:
306  SpinBox $f1.sbnLags -width 8 -justify right -editable 1 -range "0 500" \
307    -textvariable ::AutocorGraph::tmpOpt(var,nLag)
308  label $f1.lnSigma -text [mc "Sigma factor"]:
309  set tmpOpt(widget,comboSigma) [::Objects::ComboAutoFillCreate $f1.cbnSigma \
310    -width 7 -height 5 -editable 1 -justify right \
311    -values $opt(listSigmas) \
312    -textvariable ::AutocorGraph::tmpOpt(var,nSigmas)]
313  label $f1.lSigma -text [mc "Sigma value"]:
314  label $f1.lvSigma -text $tmpOpt(var,valueSigma)
315  frame $f1.f -width 20
316  grid $f1.f $f1.lnLags  $f1.sbnLags  -sticky w -pady 2
317  grid ^     $f1.lnSigma $f1.cbnSigma -sticky w -pady 2
318  grid ^     $f1.lSigma  $f1.lvSigma  -sticky w -pady 2
319  grid rowconfigure    $f1 3 -weight 1
320  grid columnconfigure $f1 2 -weight 1
321  grid $w.tf1 -sticky news -padx 2
322  grid rowconfigure    $w 0 -weight 1
323  grid columnconfigure $w 0 -weight 1
324} 
325
326#/////////////////////////////////////////////////////////////////////////////
327  proc ::AutocorGraph::OptionsDestroy {this} {
328#
329# PURPOSE: Called before options dialog is destroyed. This procedure is called
330#          by parent BayesGraph. Actually writes to ini file options dialog's
331#          options.
332#
333# PARAMETERS:
334#   this -> Instance of BayesGraph
335#
336#/////////////////////////////////////////////////////////////////////////////
337  ::AutocorGraph::WriteIniOpc $this
338}
339
340
341#/////////////////////////////////////////////////////////////////////////////
342  proc ::AutocorGraph::OptionsGet {this} {
343#
344# PURPOSE: Initializes all options variables and stores them into the
345#          temporary 'tmpOpt' array.
346#
347# PARAMETERS:
348#   this   -> Instance of BayesGraph
349#
350#/////////////////////////////////////////////////////////////////////////////
351  upvar \#0 ${this}::data data
352  upvar \#0 ${this}::options opt
353  variable tmpOpt
354
355  set tmpOpt(var,nLag)       $opt(nLag)
356  set tmpOpt(var,nSigmas)    $opt(nSigmas)
357  set tmpOpt(var,listSigmas) $opt(listSigmas)
358  set tmpOpt(var,valueSigma) $data(valueSigma)
359}
360
361
362#/////////////////////////////////////////////////////////////////////////////
363  proc ::AutocorGraph::OptionsSet {this} {
364#
365# PURPOSE: Commits all options values from the temporary 'tmpOpt' array to
366#          other structure.
367#
368# PARAMETERS:
369#   this   -> Instance of BayesGraph
370#
371#/////////////////////////////////////////////////////////////////////////////
372  upvar  \#0 ${this}::options opt
373
374  variable tmpOpt
375  set opt(nLag)       $tmpOpt(var,nLag)
376  set opt(nSigmas)    $tmpOpt(var,nSigmas)
377  set opt(listSigmas) $tmpOpt(var,listSigmas)
378}
379
380
381#/////////////////////////////////////////////////////////////////////////////
382proc ::AutocorGraph::OptionsApply {this} {
383#
384#///////////////////////////////////////////////////////////////////////////// 
385  variable tmpOpt 
386  upvar \#0 ${this}::widgets widgets
387  upvar \#0 ${this}::data data
388  upvar \#0 ${this}::options opt 
389
390  OptionsApplyNLags   $this $tmpOpt(var,nLag)
391  OptionsApplyNSigmas $this $tmpOpt(var,nSigmas)
392
393  ::bayesGraph::GrapOptCheckXYAxisAll $this
394  ::bayesGraph::GrapOptApplyAxisPos $this ::bayesGraph::tmpOpt var
395  OptionsSet $this
396}
397
398
399#/////////////////////////////////////////////////////////////////////////////
400proc ::AutocorGraph::OptionsApplyNLags { this nLag} {
401#
402#///////////////////////////////////////////////////////////////////////////// 
403  upvar \#0 ${this}::widgets widgets
404  upvar \#0 ${this}::data data
405  upvar \#0 ${this}::options opt
406  set gr $data(gr,active)
407  set grpath $widgets(gr,$gr)
408  #read values from TOL
409  set values [::tol::autocor $data(gr,$gr,type) $data(serie) $nLag]
410  set data(valueSigma) [lindex $values 2]
411  for {set i 1} {$i <= $nLag} {incr i 1} {
412    lappend  lvalues $i.0 [lindex [lindex $values 3] [expr $i-1]]
413    }
414  $grpath bar configure serie -data $lvalues
415  # Limits & Axis...
416  set data(gr,$gr,limitsY) [$grpath axis limits y]
417  set a_miny  [expr abs([lindex $data(gr,$gr,limitsY) 0])]
418  set a_maxy  [expr abs([lindex $data(gr,$gr,limitsY) 1])]
419  if { [expr $a_miny-$a_maxy] > 0 } {
420    set bound $a_miny
421  } else {
422    set bound $a_maxy
423  }
424  if {[expr $bound-(3*$data(valueSigma))] < 0 } {
425    set bound [expr 3*$data(valueSigma)]
426  }
427  ::bayesGraph::GrapOptApplyAxisLimits $this x 1              $nLag
428  ::bayesGraph::GrapOptApplyAxisLimits $this y [expr -$bound] $bound
429}
430
431
432#/////////////////////////////////////////////////////////////////////////////
433proc ::AutocorGraph::OptionsApplyNSigmas { this nSigmas} {
434#
435#///////////////////////////////////////////////////////////////////////////// 
436  global toltk_images_path
437  upvar \#0 ${this}::widgets widgets
438  upvar \#0 ${this}::data data
439  upvar \#0 ${this}::options opt
440  set gr $data(gr,active)
441  set grpath $widgets(gr,$gr)
442  #DestroyMarker $this
443 
444  set posSig [expr $nSigmas * $data(valueSigma)]
445  $grpath marker create polygon -name sigmaPos -under yes\
446    -coords {-Inf  $posSig Inf $posSig Inf Inf -Inf Inf}\
447    -stipple @[file join $toltk_images_path fill.xbm]
448  $grpath marker create polygon -name sigmaNeg -under yes\
449    -coords {-Inf  -$posSig Inf -$posSig Inf -Inf -Inf -Inf}\
450    -stipple @[file join $toltk_images_path fill.xbm]
451  $grpath marker create line -name sigmaPosL -outline red -linewidth 2\
452    -coords {-Inf  $posSig Inf $posSig}
453  $grpath marker create line -name sigmaNegL -outline red -linewidth 2\
454    -coords {-Inf  -$posSig Inf -$posSig}
455    $grpath marker create text -name mtextd -coords {Inf $posSig}  -fill "" -outline red\
456    -anchor ne -text "${nSigmas}*Sigma"
457  $grpath marker create text -name mtexti -coords {Inf -$posSig} -fill "" -outline red\
458    -anchor se -text "-${nSigmas}*Sigma"
459  $grpath marker create line -name ejeX -coords {-Inf 0 Inf 0} -dashes {2 1 1 1}
460  $grpath marker create line -name ejeY -coords {0 -Inf 0 Inf} -dashes {2 1 1 1}
461  set opt(markers) { sigmaPos sigmaNeg sigmaPosL sigmaNegL mtextd mtexti }
462}
463
464
465#/////////////////////////////////////////////////////////////////////////////
466  proc ::AutocorGraph::ReadIni {this} {
467#
468# PURPOSE: Reads autocor graph specific options from .ini file. First of all,
469#          reads options from BayesGraph. Ini file is the active graphic
470#          configuration file.
471#
472# PARAMETERS:
473#   this  -> Instance of BayesGraph
474#
475#/////////////////////////////////////////////////////////////////////////////
476  upvar \#0 ${this}::data data
477  upvar \#0 ${this}::options opt
478  #set rini ::iniFile::Read
479  set rini ::iniFile::ReadGCF
480
481  set opt(nSigmas)     [$rini AutocorGraph nSigmas 2]
482  set opt(nLag)        [$rini AutocorGraph nLag 30]
483  ::bayesGraph::ReadIni $this
484}
485
486
487#/////////////////////////////////////////////////////////////////////////////
488  proc ::AutocorGraph::WriteIni {this} {
489#
490# PURPOSE: Writes autocor graph specific options to .ini file. This procedure
491#          is called by parent BayesGraph. Ini file is the active graphic
492#          configuration file.
493#
494# PARAMETERS:
495#   this  -> Instance of BayesGraph
496#
497#/////////////////////////////////////////////////////////////////////////////
498  upvar \#0 ${this}::data data
499  upvar \#0 ${this}::widgets widgets
500  upvar \#0 ${this}::options opt
501  #set wini ::iniFile::Write
502  set wini ::iniFile::WriteGCF
503
504  $wini AutocorGraph nSigmas  $opt(nSigmas)
505  $wini AutocorGraph nLag     $opt(nLag)
506}
507
508
509#/////////////////////////////////////////////////////////////////////////////
510proc ::AutocorGraph::ReadIniOpc {this} {
511#
512#///////////////////////////////////////////////////////////////////////////// 
513  upvar \#0 ${this}::data data
514  upvar \#0 ${this}::options opt
515  set rini ::iniFile::Read
516  set opt(listSigmas) [$rini AutocorGraphOpc listSigmas {1 2 3}]
517}
518
519
520#/////////////////////////////////////////////////////////////////////////////
521proc ::AutocorGraph::WriteIniOpc {this} {
522#
523#///////////////////////////////////////////////////////////////////////////// 
524  upvar \#0 ${this}::data data
525  upvar \#0 ${this}::options opt
526  variable tmpOpt
527  set wini ::iniFile::Write
528  $wini AutocorGraphOpc listSigmas [${tmpOpt(widget,comboSigma)} cget -values]
529}
Note: See TracBrowser for help on using the repository browser.