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
}
}
}
|