source: tol/tolbase/lib/byswidget/barima/barima.tcl @ 20907d9

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

Refs #1933
Se prescinde de BLT en algunos widgets.
Otros que no se han convertido se marcan como obsoletos.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7342 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 34.0 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : barima.tcl
3# PURPOSE : Editor of definitions of ARIMA models
4#/////////////////////////////////////////////////////////////////////////////
5package require byscommon
6package require Toltcl
7package require blistboxplus
8package require bcomboboxplus
9
10#/////////////////////////////////////////////////////////////////////////////
11::snit::widget barima {
12#
13# PURPOSE: Editor of ARIMA models.
14#
15#/////////////////////////////////////////////////////////////////////////////
16# SPECIFIC OPTIONS
17#  -parent                        # Parent of the widget can be or not an
18#                                   beditmaster
19#  -coderequired                  # 1 to show the label of field required
20#                                   this next to the entry of the code,
21#                                   0 otherwise
22#  -codeeditable                  # If has a value 1, it will be possible
23#                                   to write on the entry of the code
24#  -value                         # Text of the entry of the code ARIMA
25#  -timesetrequired               # 1 to show the label of field required
26#                                   this next to the combo of the TimeSet,
27#                                   0 otherwise
28#
29# VARIABLES
30#  created                        # 1 if the widget has been created
31#  widget                         # witgets that compose barima
32#  data                           # array with data of the widgets
33#  iniconfig                      # section of this widget on ini file
34#
35#/////////////////////////////////////////////////////////////////////////////
36  widgetclass Barima
37
38  option -parent
39  option -coderequired    0
40  option -codeeditable    0
41  option -value           ""
42  option -timesetrequired 0
43 
44  variable widget
45  variable data
46  variable created 0
47  variable iniconfig "BArima"
48 
49  #///////////////////////////////////////////////////////////////////////////
50  typeconstructor {
51  #
52  # PURPOSE: bsarima typeconstructor
53  #
54  #///////////////////////////////////////////////////////////////////////////
55    global tcl_platform
56    global toltk_options
57    if { [string equal $tcl_platform(platform) "windows"] } {
58      set toltk_options(colors,SystemButtonFace) SystemButtonFace
59    } else {
60      set toltk_options(colors,SystemButtonFace) #d4d4d4
61    }
62  }
63
64  #///////////////////////////////////////////////////////////////////////////
65  constructor {args} {
66  #
67  # PURPOSE: Constructor for barima.
68  #          Instanciates all necesary widgets.
69  #
70  # PARAMETERS:
71  #   args ->  List of options for barima.
72  #
73  #//////////////////////////////////////////////////////////////////////////
74    $self configure -parent           [from args -parent ""]
75    # Create the widget
76    $self createwidget $args
77    # Apply all arguments given:
78    $self configurelist $args
79    $self configure -timesetrequired  [from args -timesetrequired 0]
80    # Inicializes the widget
81    $self _Init
82    # loads the ini config
83    $self _ReadIni
84    # Widget is now created   
85    set created 1
86  }
87 
88  destructor {
89    $self _WriteIni
90  }
91 
92  #///////////////////////////////////////////////////////////////////////////
93  #
94  # PURPOSE: Methods cget & configure
95  #
96  #/////////////////////////////////////////////////////////////////////////// 
97  onconfigure -parent { value } {
98    set options(-parent) $value
99  }
100 
101  onconfigure -coderequired { value } {
102    set options(-coderequired) $value
103    if {$value} {
104      grid $widget(frcode,r)
105    } else {
106      grid remove $widget(frcode,r)
107    }
108  }
109 
110  onconfigure -timesetrequired { value } {
111    set options(-timesetrequired) $value
112    if {$value} {
113      grid $widget(tfdef,fr,rt)
114    } else {
115      grid remove $widget(tfdef,fr,rt)
116    }
117  }
118   
119  onconfigure -codeeditable { value } {
120    set options(-codeeditable) $value
121    $widget(frcode,e) configure -editable $value
122  }
123   
124  onconfigure -value { val } {
125    set options(-value) $val
126    set data(frcode,e) $val
127  }
128 
129  oncget -value {
130    return $data(frcode,e)
131  }
132 
133  #///////////////////////////////////////////////////////////////////////////
134  # CREATION OF THE WIDGET
135  #///////////////////////////////////////////////////////////////////////////
136
137  #///////////////////////////////////////////////////////////////////////////
138  method createwidget { args } {
139  #
140  # PURPOSE: Creation of the objects that compose the widget.
141  #
142  # PARAMETERS:
143  #   args -> List of options for the bsarima.
144  #
145  #///////////////////////////////////////////////////////////////////////////
146    # Creation of the main frames
147    set widget(tfdef)   [$self _CreateTfDefinition]
148    set widget(lblist)  [$self _CreateListParams]
149    set widget(frcode)  [$self _CreateFrameCode]   
150    # gridding
151    grid $widget(tfdef)  -row 0 -column 0 -sticky news -rowspan 2
152    grid $widget(lblist) -row 0 -column 1 -sticky news -columnspan 2
153    grid $widget(frcode) -row 1 -column 1 -sticky news     
154    grid columnconfigure $self 0 -weight 0
155    grid columnconfigure $self 1 -weight 1
156    grid rowconfigure    $self 0 -weight 0
157    grid rowconfigure    $self 1 -weight 1
158  }
159 
160   
161  #///////////////////////////////////////////////////////////////////////////
162  method _CreateTfDefinition { } {
163  #
164  # PURPOSE: Create the title frame wherew the parameters of model ARIMA can
165  #          be inserted
166  #
167  # RETURN: Path of the widget created
168  #
169  #///////////////////////////////////////////////////////////////////////////
170    set widget(tfdef)  [TitleFrame $self.tfdef -text [mc "Parameters"]]
171    set widget(tfdef,fr) [$widget(tfdef) getframe]
172    # labels
173    set widget(tfdef,fr,lt) [label $widget(tfdef,fr).lt \
174                                                    -text [mc "TimeSet"]]
175    set widget(tfdef,fr,lp) [label $widget(tfdef,fr).lp \
176                                                    -text [mc "Period"]]
177    set widget(tfdef,fr,ld) [label $widget(tfdef,fr).ld \
178                                                    -text [mc "Difference"]]
179    set widget(tfdef,fr,la) [label $widget(tfdef,fr).la \
180                                                    -text [mc "AR"]]
181    set widget(tfdef,fr,lm) [label $widget(tfdef,fr).lm \
182                                                    -text [mc "MA"]]
183    $self _ClearEntrysDefinition
184    # entrys and combos
185    set data(ct) ""
186    set widget(tfdef,fr,ct) [bcomboboxplus $widget(tfdef,fr).ct \
187                             -nrows 5 -cols "timeSet" \
188                             -values [::tol::info variable TimeSet] \
189                             -variable [varname data(ct)] -showtitles false \
190                             -widthlb auto -width 17 \
191                             -modifycmd [list $self _ApplyTimeSetToPeriod] \
192                             -keyhelptext [mc "Select the TimeSet"] ]
193    #$widget(tfdef,fr,ct) activate select
194    set widget(tfdef,fr,ep) [bcomboboxplus $widget(tfdef,fr).ep \
195                             -nrows 5 -cols "period" -showtitles false \
196                             -variable [varname data(tfdef,fr,ep)] \
197                             -widthlb auto -width 17 \
198                             -keyhelptext [mc "Select or write the Period"] ]
199    [$widget(tfdef,fr,ep) getEntryKey] configure \
200                           -vcmd {::barima::validationNumber %P 1 99999999999}
201    [$widget(tfdef,fr,ep) getEntryKey] configure -validate key
202    set widget(tfdef,fr,ed) [bcomboboxplus $widget(tfdef,fr).ed \
203                             -variable [varname data(tfdef,fr,ed)] \
204                             -nrows 5 -cols "difference" -showtitles false \
205                             -widthlb auto -width 17 -values {0 1 2} \
206                             -keyhelptext \
207                      [mc "Select or write the Differences for this Period"] ]
208    [$widget(tfdef,fr,ed) getEntryKey] configure \
209                           -vcmd {::barima::validationNumber %P 0 99999999999}
210    [$widget(tfdef,fr,ed) getEntryKey] configure -validate key
211    set widget(tfdef,fr,ea) [Entry $widget(tfdef,fr).ea \
212                             -textvariable [varname data(tfdef,fr,ea)] \
213                             -vcmd {::barima::validationARMA %P} \
214                             -validate key \
215                             -helptext \
216                  [mc "Select or write the order of the AR for this Period"] ]
217    set widget(tfdef,fr,em) [Entry $widget(tfdef,fr).em \
218                             -textvariable [varname data(tfdef,fr,em)] \
219                             -vcmd {::barima::validationARMA %P} \
220                             -validate key\
221                             -helptext \
222                  [mc "Select or write the order of the MA for this Period"] ]
223    # labels of required field
224    set widget(tfdef,fr,rt) [Label $widget(tfdef,fr).rt \
225                             -image [::Bitmap::get brequired] \
226                             -helptext [mc "TimeSet required"] ]
227    set widget(tfdef,fr,rp) [Label $widget(tfdef,fr).rp \
228                             -image [::Bitmap::get brequired] \
229                             -helptext [mc "Period required"] ]
230    set widget(tfdef,fr,rd) [Label $widget(tfdef,fr).rd \
231                             -image [::Bitmap::get brequired] \
232                             -helptext [mc "Differences required"] ]
233    set widget(tfdef,fr,ra) [Label $widget(tfdef,fr).ra \
234                             -image [::Bitmap::get brequired] \
235                             -helptext [mc "AR part required"] ]
236    set widget(tfdef,fr,rm) [Label $widget(tfdef,fr).rm \
237                             -image [::Bitmap::get brequired] \
238                             -helptext [mc "MA part required"] ]
239    # buttons
240    set widget(tfdef,fr,bc) [Button $widget(tfdef,fr).bc -relief link \
241          -text [mc "Clear"] -helptext [mc "Clear parameters"] \
242          -image [::Bitmap::get eraser] -compound left -padx 2 -pady 1 \
243          -command [list $self _ClearEntrysDefinition] ]
244    set widget(tfdef,fr,bt) [Button $widget(tfdef,fr).bt -relief link \
245          -helptext [mc "Move to list"] \
246          -image [::Bitmap::get play] -compound left -padx 2 -pady 1 \
247          -command [list $self _AddToList] ]
248    set widget(tfdef,fr,bf) [Button $widget(tfdef,fr).bf -relief link \
249          -helptext [mc "Recove from list"] \
250          -image [::Bitmap::get reverse] -compound left -padx 2 -pady 1 \
251          -command [list $self _GetFromList] ]
252    # gridding
253    grid $widget(tfdef,fr,lt) $widget(tfdef,fr,rt) $widget(tfdef,fr,ct) \
254                                                                -sticky nws
255    grid $widget(tfdef,fr,lp) $widget(tfdef,fr,rp) $widget(tfdef,fr,ep) \
256                                                                -sticky nws   
257    grid $widget(tfdef,fr,ld) $widget(tfdef,fr,rd) $widget(tfdef,fr,ed) \
258                                           $widget(tfdef,fr,bt) -sticky nws
259    grid $widget(tfdef,fr,la) $widget(tfdef,fr,ra) $widget(tfdef,fr,ea) \
260                                           $widget(tfdef,fr,bf) -sticky nws
261    grid $widget(tfdef,fr,lm) $widget(tfdef,fr,rm) $widget(tfdef,fr,em) \
262                                                                -sticky nws
263    grid x                     x                   $widget(tfdef,fr,bc) \
264                                                                 -sticky ns
265    grid columnconfigure $widget(tfdef,fr) 1 -weight 0
266    return $widget(tfdef) 
267  }
268 
269 
270  #///////////////////////////////////////////////////////////////////////////
271  method _CreateListParams { } {
272  #
273  # PURPOSE: Create the blistboxplus with the list of parameters
274  #
275  # RETURN: Path of the widget created
276  #
277  #///////////////////////////////////////////////////////////////////////////
278    set widget(lblist)  [blistboxplus $self.lblist \
279                         -cols {period diff ar ma} \
280                         -titles "[mc Period] [mc Difference] AR MA" \
281                         -height 120 -nomenu 1]
282    $widget(lblist) sort configure -column period
283    $widget(lblist) sort auto true
284    return $widget(lblist) 
285  }
286 
287  #///////////////////////////////////////////////////////////////////////////
288  method _CreateFrameCode { } {
289  #
290  # PURPOSE: Create the frame with the code created
291  #
292  # RETURN: Path of the widget created
293  #
294  #///////////////////////////////////////////////////////////////////////////
295    set widget(frcode)  [frame $self.frc]
296   
297    set widget(frcode,l) [label $widget(frcode).l -text [mc "Code"] ]
298    set widget(frcode,e) [Entry $widget(frcode).e \
299                          -textvariable [varname data(frcode,e)] \
300                          -editable false \
301                          -helptext [mc "Code of the ARIMA model"]]
302    set widget(frcode,r) [Label $widget(frcode).r \
303                         -image [::Bitmap::get brequired] \
304                         -helptext [mc "Code of the ARIMA model required"] ]
305    grid $widget(frcode,l)  -row 0 -column 0 -sticky nws
306    grid $widget(frcode,r)  -row 0 -column 1 -sticky nws
307    grid $widget(frcode,e)  -row 0 -column 2 -sticky news
308    # if its father is an edit master, shows the button add code
309    if { !([$self cget -parent] eq "") && \
310          ([winfo class [$self cget -parent]] eq "BEditMaster") } {
311      set widget(frcode,bu) [Button $widget(frcode),bu  -relief link \
312            -helptext [mc "Add code as key"] -text [mc "Add code"] \
313            -image [::Bitmap::get upNext] -compound left \
314            -padx 2 -pady 0 -command [list $self _UpdateBEditMaster] ]
315      grid $widget(frcode,bu) -row 1 -column 2
316    }
317    grid columnconfigure $widget(frcode) 0 -weight 0
318    grid columnconfigure $widget(frcode) 1 -weight 0
319    grid columnconfigure $widget(frcode) 2 -weight 1
320    return $widget(frcode)
321 
322  } 
323 
324  #///////////////////////////////////////////////////////////////////////////
325  method _Init { } {
326  #
327  # PURPOSE: Initializes the widget once created. It assigns predefined
328  #          periods to certain TimeSets and initializes other components of
329  #          the widget
330  #
331  #///////////////////////////////////////////////////////////////////////////
332    if { !($created) } {
333      # assigns predefined periods to choose to certain TimeSets
334      set data(timeSet,Diario)     {1 7 365}
335      set data(timeSet,Daily)      $data(timeSet,Diario)
336      set data(timeSet,Semanal)    {1 52}
337      set data(timeSet,Weekly)     $data(timeSet,Semanal)
338      set data(timeSet,Mensual)    {1 12}
339      set data(timeSet,Monthly)     $data(timeSet,Mensual)
340      set data(timeSet,Trimestral) {1 4}
341      set data(timeSet,Quarterly)  $data(timeSet,Trimestral)
342      set data(timeSet,Anual)      {1}
343      set data(timeSet,Yearly)      $data(timeSet,Anual)
344      # assigns predefined periods by default
345      set data(timeSet,barimadefault) {}
346      for {set i 0} {$i < 365} {incr i 1} {
347        lappend data(timeSet,barimadefault) $i
348      }
349      # inicializes the period
350      $self _ApplyTimeSetToPeriod
351    }   
352  }
353     
354  #///////////////////////////////////////////////////////////////////////////
355  # BEHAVIOUR OF THE WIDGET
356  #///////////////////////////////////////////////////////////////////////////
357 
358  #///////////////////////////////////////////////////////////////////////////
359  method _ClearEntrysDefinition { } {
360  # 
361  # PURPOSE: Add the items to the list
362  #   
363  #///////////////////////////////////////////////////////////////////////////
364    set data(tfdef,fr,ep) ""
365    set data(tfdef,fr,ed) ""
366    set data(tfdef,fr,ea) ""
367    set data(tfdef,fr,em) ""
368  }
369 
370  #///////////////////////////////////////////////////////////////////////////
371  method _AddToList { } {
372  # 
373  # PURPOSE: Adds the items to the entrys of the definition of model to
374  #          blistboxplus
375  #   
376  #///////////////////////////////////////////////////////////////////////////
377    if { [$self _AllFieldsFilled] } { ;# all the entrys are filled
378      if { [$self _ValidateFields] } { ;# its values are valid
379    # apply the period to the parameters of the part AR and MA (disabled)
380        # set data(tfdef,fr,ea) [$self _ApplyPeriod $data(tfdef,fr,ep) \
381                                                  $data(tfdef,fr,ea) ]
382        # set data(tfdef,fr,em) [$self _ApplyPeriod $data(tfdef,fr,ep) \
383                                                  $data(tfdef,fr,em) ]
384        # inserts it on the list
385        $widget(lblist) insert end "$data(tfdef,fr,ep) $data(tfdef,fr,ed) \
386                                   $data(tfdef,fr,ea) $data(tfdef,fr,em)"
387        # clean the entrys of definition of model and it updates the code
388        $self _ClearEntrysDefinition
389        $self _UpdateCode
390      }     
391    } else { ;# some parameter has not filled up
392      ShowMessage E [mc "All the parameters of the model must be filled"] \
393                  $self
394    }
395  } 
396 
397  #///////////////////////////////////////////////////////////////////////////
398  method _AllFieldsFilled { } {
399  # 
400  # PURPOSE: It verifies that all entrys of definition of the model has been
401  #          filled up
402  #
403  # RETURN: 1 if all the entrys are filled up, 0 otherwise
404  #
405  #///////////////////////////////////////////////////////////////////////////
406    set result 1
407    if { ($data(tfdef,fr,ep) eq "") || ($data(tfdef,fr,ed) eq "") || \
408         ($data(tfdef,fr,ea) eq "") || ($data(tfdef,fr,em) eq "") } {
409      set result 0
410    }
411    return $result
412  }
413   
414     
415  #///////////////////////////////////////////////////////////////////////////
416  method _ValidateFields { } {
417  # 
418  # PURPOSE: It verifies the consistency of the values introduced in entrys
419  #          of definition of the model. It handles the error messages
420  #
421  # RETURN: 1 in case that the values are consistent, 0 otherwise
422  #
423  #///////////////////////////////////////////////////////////////////////////
424    set result 1
425    # It builds a list of existing periods
426    set lstPeriods {}
427    foreach id [$widget(lblist) get] {
428      lappend lstPeriods [$widget(lblist) get $id period]
429    }
430    # verifies if the period already existed
431    if { ([lsearch -exact $lstPeriods $data(tfdef,fr,ep)] eq "-1") } {
432      if {[$self _ParseParameters $data(tfdef,fr,ea)]} { ;# parse the AR
433        set data(tfdef,fr,ea) \
434                    [$self _FixConsecutiveParameters $data(tfdef,fr,ea)]
435      } else { ;# estructura de AR incorrecta
436        ShowMessage E [mc "The parameters of AR are not valid"] $self
437        set result 0     
438      }
439      if {[$self _ParseParameters $data(tfdef,fr,em)]} { ;# parse the MA
440        set data(tfdef,fr,em) \
441                    [$self _FixConsecutiveParameters $data(tfdef,fr,em)]
442      } else { ;# structure of the MA incorrect
443        ShowMessage E [mc "The parameters of MA are not valid"] $self
444        set result 0
445      }
446    } else { ;# error: the period does not have to exist
447      ShowMessage E \
448           "[mc "The period"] $data(tfdef,fr,ep) [mc "already exists"]" $self
449      set result 0
450    }   
451    return $result 
452  }
453 
454  #///////////////////////////////////////////////////////////////////////////
455  method _ParseParameters {value} {
456  # 
457  # PURPOSE: It verifies the consistency of the values introduced in entrys
458  #          of definition of AR or MA:
459  #          example X.Y..Z
460  #              - Z must be greater than Y
461  #              - Y must be greater than X
462  #              - All these values must be separated of . or of ..
463  #              - Consecutive values must be separated of . and not of
464  #                ..
465  # PARAMETERS:
466  #   value -> value of the parameter AR o MA introduced
467  #
468  # RETURN: 1 in case that the values are consistent, 0 otherwise
469  #
470  #///////////////////////////////////////////////////////////////////////////
471    set result 1
472    if { ([string last . $value] eq [expr [string length $value] - 1]) ||
473         ([string first . $value] eq 0)} { ;# ends or starts of .
474      set result 0
475    } else { ;# don't ends of .
476      # verifies that Z must be greater than Y...
477      # divided by .
478      set lstOri [split $value .]
479      # delete the { } that corresponds with ..
480      set lstDst {}
481      foreach item $lstOri {
482        if { !($item eq "") } {
483          lappend lstDst $item       
484        }
485      }
486      # verifies the order
487      set itemAux "-1"
488      foreach item $lstDst {
489        if {[expr $itemAux + 1] > $item} {
490          set result 0
491        }
492        set itemAux $item
493      }
494    }
495    return $result
496  }
497 
498 
499  #/////////////////////////////////////////////////////////////////////////// 
500  method _FixConsecutiveParameters { str } {
501  #
502  # PURPOSE: Deletes the .. in the case of en el caso that it separates
503  #          consecutive numbers in the definition of an model AR o MA.
504  #          By example 2..3 has not sense, it would be 2.3. This function
505  #          returns the string without this possible inconsistency
506  #
507  # PARAMETERS: The string to analyze.
508  #
509  # RETURN: The chain with this possible inconsistency corrected.
510  #
511  #///////////////////////////////////////////////////////////////////////////
512    set strResult ""
513    # The chain is divided by . and the variables are initialized
514    set lstOri [split $str .]
515    set nAux 0
516    set double 0
517    # iterates on the list
518    foreach item $lstOri {
519       # appears a .
520       if { $item eq {} } {
521        set double 1  ;# indicates that it has appeared a .
522        append strResult .
523      } else {
524        if {$double} { ;# have been ..
525          if {!($item eq [expr $nAux + 1]) } { ;# the numbers ARE NOT
526                                               ;# consecutive
527            # the ... are given normally
528            append strResult $item
529            append strResult .           
530          } else { ;# the numbers ARE consecutive:  it is corrected
531            # deletes a .
532            set strResult [string range $strResult 0 \
533                                  [expr [string length $strResult] - 2 ] ]
534            append strResult $item
535            append strResult .
536          }
537        } else {  ;# have not been ..
538          append strResult $item
539          append strResult .
540        }
541        # the variables are prepared to begin
542        set nAux $item
543        set double 0
544      }
545    }
546    # a point of the end is eliminated and the result is given back
547    set strResult [string range $strResult 0 \
548                          [expr [string length $strResult] - 2 ] ]
549    return $strResult
550  }
551   
552   
553  #/////////////////////////////////////////////////////////////////////////// 
554  method _UpdateCode { } {
555  # 
556  # PURPOSE: It updates the content of the code based on the elements
557  #         introduced in blistboxplus
558  #
559  #///////////////////////////////////////////////////////////////////////////
560    set data(frcode,e) [$self _GetCode]   
561  }
562   
563  #/////////////////////////////////////////////////////////////////////////// 
564  method _GetFromList { } {
565  # 
566  # PURPOSE: It takes the selected row from blistboxplus and load it in entrys
567  #          of definition of the model
568  #
569  #///////////////////////////////////////////////////////////////////////////
570    # obtains the selection of blistboxplus and eliminates it
571    set idSel [$widget(lblist) selection get]
572    if { (!([llength [$widget(lblist) get]] eq 0)) && \
573         (!($idSel eq "")) } {  ;# there is nothing or nothing
574                                                # have selected
575      # Cleans entrys of definition of the model
576      $self _ClearEntrysDefinition
577      set selected [$widget(lblist) get $idSel]
578
579      $widget(lblist) delete $idSel
580
581      # translates and passes its content to entrys
582      set data(tfdef,fr,ep) [lindex $selected 0]
583      set data(tfdef,fr,ed) [lindex $selected 1]
584      set data(tfdef,fr,ea) [lindex $selected 2]
585      set data(tfdef,fr,em) [lindex $selected 3]
586
587      #set data(tfdef,fr,ea) [$self _ApplyPeriod [lindex $selected 0] \
588                                              [lindex $selected 2] "backward"]
589      #set data(tfdef,fr,em) [$self _ApplyPeriod [lindex $selected 0] \
590                                              [lindex $selected 3] "backward"]
591                                             
592      # once brought to entrys, it updates the code
593      $self _UpdateCode
594      $widget(lblist) first
595      if { [llength [$widget(lblist) get]] eq 0 } {
596        set data(frcode,e) ""
597      }
598    }
599  }
600 
601  #/////////////////////////////////////////////////////////////////////////// 
602  method _GetCode { } {
603  #
604  # PURPOSE: Returns the code ARIMA based on the content of blistboxplus with
605  #          all its parameters
606  #
607  # RETURN: A string with the code
608  #
609  #///////////////////////////////////////////////////////////////////////////
610    set strP ""
611    set strD ""
612    set strA ""   
613    set strM ""
614    # obtains the list of identifiers without order
615    set lstIds    [$widget(lblist) get]
616    # the list of identifiers by the period is ordered
617    # obtains a list of {id period}... is the same as {value index}
618    set lstValues {}
619    foreach id $lstIds {
620      set period [$widget(lblist) get $id period]
621      lappend lstValues "$id $period"
622    }
623    # the list of values (ids) is ordered by the index (values)   
624    set lstValues [lsort -index 1 $lstValues]
625    # the list of values (ids) ordered is obtained   
626    set lstIds {}
627    foreach pair $lstValues {
628      lappend lstIds [lindex $pair 0]
629    }   
630    # iterates on the list ordered of identifiers     
631    foreach id $lstIds {
632      # constructs the P part
633      set itemP [$widget(lblist) get $id period]
634      append strP $itemP "_"
635      # constructs the DIF part
636      set itemD [$widget(lblist) get $id diff]     
637      append strD $itemD "_"
638      # constructs the AR part
639      set itemA [$widget(lblist) get $id ar]
640      append strA $itemA "_"
641      # constructs the MA part
642      set itemM [$widget(lblist) get $id ma]
643      append strM $itemM "_"
644    }
645    # clears _ that exceeds in the end
646    set strP [string range $strP 0 [expr [string length $strP] - 2 ] ]
647    set strD [string range $strD 0 [expr [string length $strD] - 2 ] ]
648    set strA [string range $strA 0 [expr [string length $strA] - 2 ] ]
649    set strM [string range $strM 0 [expr [string length $strM] - 2 ] ]
650    # joins everything to form code ARIMA
651    set result ""
652    append result "P" $strP "DIF" $strD "AR" $strA "MA" $strM
653    # return the result
654    return $result
655  }
656     
657  #///////////////////////////////////////////////////////////////////////////       
658  method _ApplyPeriod {period str {sense "fordward"}} {
659  #
660  # PURPOSE: Applies a period to patameters AR or MA of the model.
661  #          Either from entrys to blistboxplus (forward) or
662  #          from blistboxplus to entrys (backward)
663  #
664  # PARAMETERS:
665  #  period -> period selected
666  #  str -> parameters AR o MA to treat
667  #  sense -> sense of the treatment
668  #
669  # RETURN: Original string with the applied period
670  #
671  # TODO: Disabled to give greater flexibility
672  #///////////////////////////////////////////////////////////////////////////   
673    set strResult ""
674    # split the string by .
675    set lstOri [split $str .]
676    set lstDst {}
677    set firstItem "-1"
678    foreach item $lstOri {
679      # ignoramos los .
680      if {$item eq {}} {
681        lappend lstDst {}
682      } else {
683        if {$item eq 0} { ;# the 0's are left
684          lappend lstDst $item
685        } else {
686          # applies the period forwards or backwards
687          if { $sense eq "fordward"} {         
688            lappend lstDst [expr $period + $item - 1]
689          } else {
690            lappend lstDst [expr $item - $period + 1]
691          }
692        }
693      }
694    }
695    # recomposes string to give back it
696    set strResult
697    foreach item $lstDst {
698      append strResult $item .
699    }
700    # clears end . that exceeds and retuns the result
701    set strResult [string range $strResult 0 \
702                                     [expr [string length $strResult] - 2 ] ]
703    return $strResult
704  }
705 
706  #///////////////////////////////////////////////////////////////////////////
707  method _UpdateBEditMaster { } {
708  #
709  # PURPOSE: Updates the code of the beditmaster when click on update code
710  #          button
711  #///////////////////////////////////////////////////////////////////////////
712    if { !($data(frcode,e) eq "") } {
713      [$self cget -parent] showvalue -status ins -values \
714                          [list [list code $data(frcode,e) ] ]
715    }
716  }
717 
718  #///////////////////////////////////////////////////////////////////////////
719  method _ApplyTimeSetToPeriod { } {
720  #
721  # PURPOSE: Gives the values of the selected TimeSet
722  #
723  #///////////////////////////////////////////////////////////////////////////
724    if {$created} {
725      set name "timeSet,$data(ct)"
726      if { !([array names data $name] eq "") } {
727        $widget(tfdef,fr,ep) configure -values $data($name)
728      } else {
729        $widget(tfdef,fr,ep) configure -values $data(timeSet,barimadefault)
730      }
731    }
732  }
733 
734 
735  #/////////////////////////////////////////////////////////////////////////////
736  method _WriteIni {} {
737  #
738  # PURPOSE: Write to the ini file the TimeSet selected
739  #
740  #/////////////////////////////////////////////////////////////////////////////
741    set wini ::iniFile::Write
742    $wini $iniconfig TimeSet [$self get "TimeSet"]   
743  }
744
745  #/////////////////////////////////////////////////////////////////////////////
746  method _ReadIni {} {
747  #
748  # PURPOSE: Read from ini file the TimeSet selected
749  #
750  #/////////////////////////////////////////////////////////////////////////////
751    set rini ::iniFile::Read 
752    set data(ct) [$rini $iniconfig TimeSet ""]
753    # apply the TimeSet to the widget
754    $self _ApplyTimeSetToPeriod
755  }
756 
757  #///////////////////////////////////////////////////////////////////////////
758  # PUBLIC METHODS
759  #///////////////////////////////////////////////////////////////////////////
760 
761  #///////////////////////////////////////////////////////////////////////////
762  method get { args } {
763  #
764  # PURPOSE: Returns a string with certain information of widget.
765  #
766  # PARAMETERS:
767  #   args -> If has a value
768  #           "TimeSet" returns the TimeSet selected
769  #
770  # RETURNS: The string with the information required
771  #
772  #///////////////////////////////////////////////////////////////////////////
773    if { $args eq "TimeSet" } {
774      return $data(ct)
775    }
776  }
777 
778  #///////////////////////////////////////////////////////////////////////////
779  method state {stt args} {
780  #
781  # PURPOSE: We applied an option to the elements of the component.
782  #          To entry of the code, the button and the rest of fields entry.
783  #
784  # PARAMETERS:
785  #   stt: option to apply
786  #     normal    -> ep(y) ed(y) ea(y) em(y) e(y) bc(y) bt(y) bf(y)
787  #     disabled  -> ep(n) ed(n) ea(n) em(n) e(n) bc(n) bt(n) bf(n)
788  #
789  #///////////////////////////////////////////////////////////////////////////
790  # introduces values
791    switch $stt {
792      "normal" {
793        BfoActivateWidget $widget(tfdef,fr,ep)   "normal"
794        BfoActivateWidget $widget(tfdef,fr,ed)   "normal"
795        BfoActivateWidget $widget(tfdef,fr,ea)   "normal"
796        BfoActivateWidget $widget(tfdef,fr,em)   "normal"
797        BfoActivateWidget $widget(frcode,e)      "normal"
798        BfoActivateWidget $widget(tfdef,fr,bc)   "normal"
799        BfoActivateWidget $widget(tfdef,fr,bt)   "normal"
800        BfoActivateWidget $widget(tfdef,fr,bf)   "normal"
801        if {info exists $widget(frcode,bu) } {
802          BfoActivateWidget $widget(frcode,bu)     "normal"
803        }
804      }
805      "disabled" {
806        #BfoActivateWidget $widget(tfdef,fr,ep)   "disabled"
807        #BfoActivateWidget $widget(tfdef,fr,ed)   "disabled"
808        #BfoActivateWidget $widget(tfdef,fr,ea)   "disabled"
809        #BfoActivateWidget $widget(tfdef,fr,em)   "disabled"
810        #BfoActivateWidget $widget(frcode,e)      "disabled"
811        #BfoActivateWidget $widget(tfdef,fr,bc)   "disabled"
812        #BfoActivateWidget $widget(tfdef,fr,bt)   "disabled"
813        #BfoActivateWidget $widget(tfdef,fr,bf)   "disabled"
814        BfoActivateWidget $widget(frcode,bu)     "disabled"
815      }
816      default {
817        puts "BSArima Activate ERROR: invalid state: $stt"
818      }
819    }
820  }   
821} ;#snit::widget
822
823package provide barima 1.0
824
825#/////////////////////////////////////////////////////////////////////////////
826namespace eval ::barima {
827#/////////////////////////////////////////////////////////////////////////////
828}
829
830#/////////////////////////////////////////////////////////////////////////////
831proc ::barima::validationNumber {value min max} {
832#
833# PURPOSE: Validate that the numbers introduced in entry are numbers, and
834#          they are in a rank of certain values.
835#          It returns 1 if the introduced number is greater than the minimum,
836#          minor of the maximum or this even empty.
837#
838# RETURN: 1 if the content of the entry is valid. 0 otrherwise
839#
840# TODO: To put within widget
841#/////////////////////////////////////////////////////////////////////////////
842  set result 1
843  if {($value eq "")} { ;# entry empty
844    set result 1
845  } else {
846    if { [string is digit $value] eq 1 } { ;# are digits
847      if { (($value >= $min) && ($value <= $max)) } { ;# digits in range
848        set result 1
849      } else { ;# digits out of range
850        set result 0
851      }
852    } else { ;# are't digits
853      set result 0
854    }
855  }
856  return $result
857}
858
859 
860#/////////////////////////////////////////////////////////////////////////////
861proc ::barima::validationARMA {value} {
862#
863# PURPOSE: Validate that the numbers introduced in the entry of definition
864#          the model are valid
865#
866# RETURN: 1 if the content of the entry is valid. 0 otrherwise
867#
868# TODO: To put within widget
869#/////////////////////////////////////////////////////////////////////////////
870  set result 1
871  if {($value eq "")} { ;# entry empty
872    set result 1
873  } else {
874    ;# wants to introduce .. or string  begins by .   
875    if { (!([string last ... $value] eq "-1"))} {
876      set result 0
877    } else { ;# is not wanted to introduce more than ..     
878      set copyValue [string map {. 0} $value] ;# replace the . by 0
879      if { [string is digit $copyValue] eq 1 } { ;# are digits
880        set result 1
881      } else { ;# aren't digits
882        set result 0
883      }
884    }
885  }
886  return $result
887}
888
889proc test_barima { } { 
890  destroy .top
891  toplevel .top
892  set tf1 [TitleFrame .top.f1 -text "BArima test"]
893  set f1 [ .top.f1 getframe ] 
894 
895  # Create barima
896  set ba [barima $f1.ba]
897  puts "barima widget: $ba"
898 
899  pack $tf1 -expand yes -fill both
900  pack $ba -expand yes -fill both
901}
Note: See TracBrowser for help on using the repository browser.