File: sumtable.tcl

package info (click to toggle)
moomps 4.6-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 2,444 kB
  • ctags: 2,307
  • sloc: tcl: 34,882; sh: 167; makefile: 91
file content (358 lines) | stat: -rw-r--r-- 17,159 bytes parent folder | download | duplicates (2)
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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: sumtable.tcl,v 2.76 2005/02/21 21:35:47 jfontain Exp $


class summaryTable {

if {$global::withGUI} {

    proc summaryTable {this parentPath args} composite {[new frame $parentPath] $args} viewTable {} viewer {} {
        composite::complete $this
        constructor $this
    }

} else {                          ;# remove Tk dependant code since this class can be used by monitoring daemon in a Tcl environment

    proc summaryTable {this args} switched {$args} viewTable {} viewer {} {
        switched::complete $this
        constructor $this
    }

}

    proc constructor {this} {
        set dataName ::summaryTable::$(nextDataIndex)data        ;# generate unique name based on index (available after completion)
        incr (nextDataIndex)
        catch {unset $dataName}
        array set $dataName [list\
            updates 0\
            0,label [mc data] 0,type ascii 0,message [mc {data cell description}]\
            1,label [mc current] 1,type real 1,message [mc {current value}]\
            2,label [mc average] 2,type real\
                2,message [mc {average value (since viewer creation in real time mode or for range in database mode)}]\
            3,label [mc minimum] 3,type real\
                3,message [mc {minimum value (since viewer creation in real time mode or for range in database mode)}]\
            4,label [mc maximum] 4,type real\
                4,message [mc {maximum value (since viewer creation in real time mode or for range in database mode)}]\
            5,label [mc deviation] 5,type real\
                5,message [mc {standard deviation (since viewer creation in real time mode or for range in database mode)}]\
            indexColumns 0\
            sort {0 increasing}\
        ]
if {$global::withGUI} {
        viewTable::createTable $this $dataName "summaryTable::dragData $this"
        updateMessage $this
} else {
        viewTable::setDataName $this $dataName
}
    }

    proc ~summaryTable {this} {
if {$global::withGUI} {
        variable ${this}cellRange                                                                                ;# for history mode

        foreach {name wish} [array get {} $this,rowLastWish,*] {                   ;# delete remaining last wishes, one for each row
            delete $wish                                                                                ;# which in turn deletes row
        }
        catch {unset ${this}cellRange}
        if {[string length $composite::($this,-deletecommand)] > 0} {
            uplevel #0 $composite::($this,-deletecommand)                                   ;# always invoke command at global level
        }
} else {
        if {[string length $switched::($this,-deletecommand)] > 0} {
            uplevel #0 $switched::($this,-deletecommand)
        }
}
    }

if {$global::withGUI} {

    proc iconData {} {
        return {
            R0lGODdhJAAkAOMAAPj8+Hh4eAAAAHh8eNjc2ICEgIiQiJCYkKCkoKisqLi8uMDEwMjQyNDY0ODk4Ojs6CwAAAAAJAAkAAAE/hDIKQO99s5cNeUaiH2aYJ5o
            qqZbFQyDQBDDbN/1jRMmDIMymm43nNUEg84lmCs2h8ckQARA+q7YLBapDLxiAGF4TAjXyOSj9UeRAZLl+BiOLie505JZzj/z93hUa1qEWYEuMExFRotCPT5A
            jItPOlFKbZJOjZZ5S4WfW1IZXol7daZ/joNSEm50f69od6J6Yql+dZyCoLwxtFNfipObPKuYQsPDh0uZUMTLbb2gyyy2uamAKleup3bdb1VZBeMFAqjX3VHk
            4wbtBqvSoe7tB/UHwprKA/b1CP4I+Jzp++cvgcEEASs9G3DQoIKHClZInNgD4sMFGDHGA5URI4OPIyBDihxJsmSDkyhTqlzJsqWDlzBjypxJs+aDmzhz6tzJ
            s2cEADs=
        }
    }

}

    proc options {this} {
        # data index must be forced so that initialization always occur
if {$global::withGUI} {
        set font $font::(mediumBold)
} else {
        set font {}
}
        return [list\
            [list -cellrows {} {}]\
            [list -dataindex {}]\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -interval 0 0]\
        ]
    }

    proc set-cellrows {this value} {                                                 ;# restore cell to row mapping from a save file
if {$global::withGUI} {
        set complete $composite::($this,complete)
} else {
        set complete $switched::($this,complete)
}
        if {$complete} {
            error {option -cellrows cannot be set dynamically}
        }
        viewTable::setCellRows $this $value
    }

    set (nextDataIndex) 0                            ;# used when data array index is not specified as an option when creating table
    proc reset {} {                                  ;# reset generated counter (invoker must insure that there are no viewers left)
        set (nextDataIndex) 0
    }
    # data array name index must be specifiable so that data viewers depending on summary table data array name (through their
    # monitored cells) do not fail accessing that data (required when generating viewers from save file)
    proc set-dataindex {this value} {                                                         ;# always invoked at construction time
if {$global::withGUI} {
        set complete $composite::($this,complete)
} else {
        set complete $switched::($this,complete)
}
        if {$complete} {
            error {option -dataindex cannot be set dynamically}
        }
        if {[string length $value] > 0} {                           ;# specified, else use internally generated next available index
            if {$value < $(nextDataIndex)} {
                error "specified data index ($value) is lower than internal summary table index"
            }
            set (nextDataIndex) $value
        }
    }

    proc set-deletecommand {this value} {}

    proc set-draggable {this value} {
if {$global::withGUI} {
        set complete $composite::($this,complete)
} else {
        set complete $switched::($this,complete)
}
        if {$complete} {
            error {option -draggable cannot be set dynamically}
        }
    }

    proc set-interval {this value} {}                                                   ;# only so that history mode can be detected

    proc supportedTypes {this} {
        return $global::numericDataTypes
    }

    proc monitorCell {this array row column} {
if {$global::withGUI} {
        variable ${this}cellRange
}

        set cell ${array}($row,$column)
        if {[string length [viewTable::row $this $cell]] > 0} return                                     ;# already displayed, abort
if {$global::withGUI} {
        if {($composite::($this,-interval) == 0) && ![string equal [lindex [modules::decoded $array] 0] instance]} {
            lifoLabel::flash $global::messenger $viewTable::(monitorInstanceCellsMessage)
            return                                                   ;# in history mode, ignore any cell not from an instance module
        }
}
        foreach {label incomplete} [viewer::label $array $row $column] {}
        set row [viewTable::register $this $cell $array]                                                           ;# view table row
        set dataName $viewTable::($this,dataName)
        set ${dataName}($row,0) $label
        set current ?
        catch {set current [set $cell]}                                                                        ;# cell may not exist
        set ${dataName}($row,1) $current
        array set $dataName [list $row,2 ? $row,3 ? $row,4 ? $row,5 ?]         ;# initialize average, minimum, maximum and deviation
        set ${dataName}($row,updates) 0
        set ${dataName}($row,sum) 0.0
        set ${dataName}($row,squares) 0.0                                ;# sum of squared values for standard deviation calculation
if {$global::withGUI} {
        set ${this}cellRange($cell,start) 0                                                                      ;# for history mode
        set ${this}cellRange($cell,end) 0
        # setup action when a row is deleted through a cell drop in eraser site
        set ($this,rowLastWish,$row) [new lastWish "summaryTable::deleteRow $this $cell"]
}
        if {$incomplete} {                                                                         ;# label cannot be determined yet
            set ($this,relabel,$row) {}
        }
        incr ${dataName}(updates)                       ;# let data table update itself (so colors can be set on cells, for example)
if {$global::withGUI} {
        updateMessage $this
}
    }

    proc update {this array} {
        set dataName $viewTable::($this,dataName)
        set updated 0
        foreach {cell row} [viewTable::cellsAndRows $this] {
            if {[string first $array $cell] != 0} continue             ;# no need to update if cell does not belong to updated array
            if {[catch {set current [set $cell]}] || [string equal $current ?]} {                  ;# cell does not exist or is void
                set ${dataName}($row,1) ?                               ;# do not touch other columns as their content remains valid
                if {$global::withGUI && ($composite::($this,-interval) == 0)} {            ;# history mode (available from GUI only)
                    processHistory $this $row $cell                                       ;# last value may be void but others valid
                }
            } else {                                                                                                ;# data is valid
                set ${dataName}($row,1) $current
                if {[string is double -strict $current]} {updateCalculations $this $row $cell}          ;# process numeric data part
            }
            if {[info exists ($this,relabel,$row)] && [info exists $cell]} {               ;# if label is not yet defined, update it
                viewer::parse $cell ignore cellRow cellColumn type
                foreach [list ${dataName}($row,0) incomplete] [viewer::label $array $cellRow $cellColumn] {}
                if {!$incomplete} {                                                                  ;# label now completely defined
                    unset ($this,relabel,$row)
                }
            }
            set updated 1
        }
        if {$updated} {incr ${dataName}(updates)}                                                    ;# let data table update itself
    }

    proc cells {this} {           ;# return cells in creation order (increasing row) so that restoring from save file works properly
        return [viewTable::cells $this]
    }

    proc updateCalculations {this row cell} {
        if {$global::withGUI && ($composite::($this,-interval) == 0)} {                    ;# history mode (available from GUI only)
            processHistory $this $row $cell
        } else {                                                                                                        ;# real time
            set dataName $viewTable::($this,dataName)
            set current [set ${dataName}($row,1)]
            set sum [expr {[set ${dataName}($row,sum)] + $current}]
            set updates [incr ${dataName}($row,updates)]
            set average [expr {$sum / $updates}]
            set ${dataName}($row,2) [format %.2f $average]
            set value [set ${dataName}($row,3)]
            if {[string equal $value ?] || ($current < $value)} {                                     ;# possibly initialize minimum
                set ${dataName}($row,3) $current
            }
            set value [set ${dataName}($row,4)]
            if {[string equal $value ?] || ($current > $value)} {                                     ;# possibly initialize maximum
                set ${dataName}($row,4) $current
            }
            set squares [expr {[set ${dataName}($row,squares)] + ($current * $current)}]
            set value 0                                                           ;# for the first sample as division by zero occurs
            catch {set value [expr {sqrt(($squares + ($updates * $average * $average) - (2 * $average * $sum)) / ($updates - 1))}]}
            set ${dataName}($row,5) [format %.2f $value]
            set ${dataName}($row,sum) $sum
            set ${dataName}($row,squares) $squares
        }
    }

if {$global::withGUI} {

    proc processHistory {this row cell} {
        variable ${this}cellRange

        set dataName $viewTable::($this,dataName)
        foreach {start end} [databaseInstances::range $cell] {}               ;# database cell range in seconds (limited by cursors)
        if {[string length $start] == 0} {                                                                        ;# no history data
            set ${this}cellRange($cell,start) 0
            set ${this}cellRange($cell,end) 0
            set ${dataName}($row,2) ?
            set ${dataName}($row,3) ?
            set ${dataName}($row,4) ?
            set ${dataName}($row,5) ?
            return
        }
        if {([set ${this}cellRange($cell,start)] == $start) && ([set ${this}cellRange($cell,end)] == $end)} {
            return                                                      ;# no range change: avoid potentially lengthy database query
        }
        blt::vector create values
        set start 0
        foreach {stamp value} [databaseInstances::history $cell] {                                        ;# empty if database error
            if {$start == 0} {set start $stamp}
            if {[string length $value] == 0} continue                  ;# void value (instead of ? since data comes from a database)
            values append $value
        }
        if {[info exists stamp]} {                                         ;# remember whole data (even including voids) time limits
            set ${this}cellRange($cell,start) $start
            set ${this}cellRange($cell,end) $stamp
        }                                                                                           ;# else a database error occured
        if {[values length] > 0} {
            blt::vector create result
            result expr {mean(values)}
            set ${dataName}($row,2) [format %.2f [result index 0]]
            result expr {min(values)}
            regsub {\.0$} [result index 0] {} ${dataName}($row,3)                           ;# strip .0 trailer if result is integer
            result expr {max(values)}
            regsub {\.0$} [result index 0] {} ${dataName}($row,4)                           ;# strip .0 trailer if result is integer
            result expr {sdev(values)}                                                                         ;# standard deviation
            set ${dataName}($row,5) [format %.2f [result index 0]]
            blt::vector destroy result
        } else {                                                                                            ;# there were only voids
            set ${dataName}($row,2) ?
            set ${dataName}($row,3) ?
            set ${dataName}($row,4) ?
            set ${dataName}($row,5) ?
        }
        blt::vector destroy values
    }

    proc dragData {this format} {
        switch $format {
            OBJECTS {
                set lastWishes {}
                foreach row [viewTable::selectedRows $this $format] {
                    lappend lastWishes $($this,rowLastWish,$row)
                }
                if {[llength $lastWishes] == 0} {
                    return $this                                                                  ;# self destruct if no rows remain
                } else {
                    return $lastWishes
                }
            }
            DATACELLS {
                return [viewTable::dragCells $this]
            }
        }
    }

    proc deleteRow {this cell} {                                   ;# last wish object is deleted after completion of this procedure
        variable ${this}cellRange

        set dataName $viewTable::($this,dataName)
        set row [viewTable::deleteRow $this $cell]
        unset ${dataName}($row,0) ${dataName}($row,1) ${dataName}($row,2) ${dataName}($row,3) ${dataName}($row,4)\
            ${dataName}($row,5) ($this,rowLastWish,$row) ${dataName}($row,updates) ${dataName}($row,sum) ${dataName}($row,squares)
        catch {unset ${this}cellRange($cell,start) ${this}cellRange($cell,end)}                                  ;# for history mode
        viewTable::update $this
        updateMessage $this
    }

    proc initializationConfiguration {this} {
        return [viewTable::initializationConfiguration $this]
    }

    proc monitored {this cell} {
        return [viewTable::monitored $this $cell]
    }

    proc setCellColor {this source color} {
        viewTable::setCellColor $this $source $color
    }

    proc updateMessage {this} {
        if {[viewTable::numberOfRows $this]} {
            centerMessage $widget::($this,path) {}
        } else {
            centerMessage $widget::($this,path)\
                [mc "statistics table:\ndrop data cell(s)"] $viewer::(background) $global::viewerMessageColor
        }
    }

    proc updateLabels {this} {
        viewTable::updateLabels $this
    }

}

}