source: trunk/gui/scripts/histogram.tcl @ 4661

Last change on this file since 4661 was 3330, checked in by gah, 12 years ago

merge (by hand) with Rappture1.2 branch
File size: 14.9 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2 
3# ----------------------------------------------------------------------
4#  COMPONENT: histogram - extracts data from an XML description of a field
5#
6#  This object represents a histogram of data in an XML description of
7#  simulator output.  A histogram is similar to a field, but a field is
8#  a quantity versus position in device.  A histogram is any quantity
9#  versus any other quantity.  This class simplifies the process of
10#  extracting data vectors that represent the histogram.
11# ======================================================================
12#  AUTHOR:  Michael McLennan, Purdue University
13#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
14#
15#  See the file "license.terms" for information on usage and
16#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17# ======================================================================
18package require Itcl
19package require BLT
20
21namespace eval Rappture { # forward declaration }
22
23itcl::class Rappture::Histogram {
24    constructor {xmlobj path} { # defined below }
25    destructor { # defined below }
26
27    public method components {{pattern *}}
28    public method mesh { component }
29    public method values { component }
30    public method widths { component }
31    public method xlabels { component }
32    public method limits {which}
33    public method xmarkers {}
34    public method ymarkers {}
35    public method hints {{key ""}}
36
37    protected method Build {}
38    private method Clear { {comp ""} }
39    private method ParseData { comp }
40
41    private variable _xmlobj ""  ;# ref to lib obj with histogram data
42    private variable _hist ""    ;# lib obj representing this histogram
43    private variable _widths     ;# array of vectors of bin widths
44    private variable _yvalues    ;# array of vectors of bin heights along
45                                 ;# y-axis.
46    private variable _xvalues    ;# array of vectors of bin locations along
47                                 ;# x-axis.
48    private variable _xlabels    ;# array of labels
49    private variable _hints      ;# cache of hints stored in XML
50    private variable _xmarkers "";# list of {x,label,options} triplets.
51    private variable _ymarkers "";# list of {y,label,options} triplets.
52    private common _counter 0    ;# counter for unique vector names
53    private variable _comp2hist  ;# maps component name => x,y,w,l vectors
54}
55
56# ----------------------------------------------------------------------
57# CONSTRUCTOR
58# ----------------------------------------------------------------------
59itcl::body Rappture::Histogram::constructor {xmlobj path} {
60    if {![Rappture::library isvalid $xmlobj]} {
61        error "bad value \"$xmlobj\": should be LibraryObj"
62    }
63    set _xmlobj $xmlobj
64    set _hist [$xmlobj element -as object $path]
65
66    # build up vectors for various components of the histogram
67    Build
68}
69
70# ----------------------------------------------------------------------
71# DESTRUCTOR
72# ----------------------------------------------------------------------
73itcl::body Rappture::Histogram::destructor {} {
74    # don't destroy the _xmlobj! we don't own it!
75    itcl::delete object $_hist
76    Clear
77}
78
79# ----------------------------------------------------------------------
80# USAGE: mesh
81#
82# Returns the vector for the histogram bin locations along the
83# x-axis.
84# ----------------------------------------------------------------------
85itcl::body Rappture::Histogram::mesh { comp } {
86    if { [info exists _xvalues($comp)] } {
87        return $_xvalues($comp)
88    }
89    return ""
90}
91
92# ----------------------------------------------------------------------
93# USAGE: heights
94#
95# Returns the vector for the histogram bin heights along the y-axis.
96# ----------------------------------------------------------------------
97itcl::body Rappture::Histogram::values { comp } {
98    if { [info exists _yvalues($comp)] } {
99        return $_yvalues($comp)
100    }
101    return ""
102}
103
104# ----------------------------------------------------------------------
105# USAGE: widths
106#
107# Returns the vector for the specified histogram component <name>.
108# If the name is not specified, then it returns the vectors for the
109# overall histogram (sum of all components).
110# ----------------------------------------------------------------------
111itcl::body Rappture::Histogram::widths { comp } {
112    if { [info exists _widths($comp)] } {
113        return $_widths($comp)
114    }
115    return ""
116}
117
118# ----------------------------------------------------------------------
119# USAGE: xlabels
120#
121# Returns the vector for the specified histogram component <name>.
122# If the name is not specified, then it returns the vectors for the
123# overall histogram (sum of all components).
124# ----------------------------------------------------------------------
125itcl::body Rappture::Histogram::xlabels { comp } {
126    if { [info exists _xlabels($comp)] } {
127        return $_xlabels($comp)
128    }
129    return ""
130}
131
132# ----------------------------------------------------------------------
133# USAGE: xmarkers
134#
135# Returns the list of settings for each marker on the x-axis.
136# If no markers have been specified the empty string is returned.
137# ----------------------------------------------------------------------
138itcl::body Rappture::Histogram::xmarkers {} {
139    return $_xmarkers;
140}
141
142# ----------------------------------------------------------------------
143# USAGE: components ?<pattern>?
144#
145# Returns a list of names for the various components of this curve.
146# If the optional glob-style <pattern> is specified, then it returns
147# only the component names matching the pattern.
148# ----------------------------------------------------------------------
149itcl::body Rappture::Histogram::components {{pattern *}} {
150    set rlist ""
151    foreach name [array names _comp2hist] {
152        if {[string match $pattern $name]} {
153            lappend rlist $name
154        }
155    }
156    return $rlist
157}
158
159# ----------------------------------------------------------------------
160# USAGE: ymarkers
161#
162# Returns the list of settings for each marker on the y-axis.
163# If no markers have been specified the empty string is returned.
164# ----------------------------------------------------------------------
165itcl::body Rappture::Histogram::ymarkers {} {
166    return $_ymarkers;
167}
168
169# ----------------------------------------------------------------------
170# USAGE: limits x|xlin|xlog|y|ylin|ylog
171#
172# Returns the {min max} limits for the specified axis.
173#
174# What does it mean to view a distribution (the bins) as log scale?
175#
176# ----------------------------------------------------------------------
177itcl::body Rappture::Histogram::limits {which} {
178    set min ""
179    set max ""
180    switch -- $which {
181        x - xlin { set pos 0; set log 0; set axis xaxis }
182        xlog { set pos 0; set log 1; set axis xaxis }
183        y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
184        ylog - vlog { set pos 1; set log 1; set axis yaxis }
185        default {
186            error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
187        }
188    }
189
190    blt::vector create tmp
191    blt::vector create zero
192    foreach comp [array names _comphist] {
193        set vname [lindex $_comp2hist($comp) $pos]
194        $vname variable vec
195
196        if {$log} {
197            # on a log scale, use abs value and ignore 0's
198            $vname dup tmp
199            $vname dup zero
200            zero expr {tmp == 0}            ;# find the 0's
201            tmp expr {abs(tmp)}             ;# get the abs value
202            tmp expr {tmp + zero*max(tmp)}  ;# replace 0's with abs max
203            set vmin [blt::vector expr min(tmp)]
204            set vmax [blt::vector expr max(tmp)]
205        } else {
206            set vmin $vec(min)
207            set vmax $vec(max)
208        }
209
210        if {"" == $min} {
211            set min $vmin
212        } elseif {$vmin < $min} {
213            set min $vmin
214        }
215        if {"" == $max} {
216            set max $vmax
217        } elseif {$vmax > $max} {
218            set max $vmax
219        }
220    }
221    blt::vector destroy tmp zero
222
223    set val [$_hist get $axis.min]
224    if {"" != $val && "" != $min} {
225        if {$val > $min} {
226            # tool specified this min -- don't go any lower
227            set min $val
228        }
229    }
230
231    set val [$_hist get $axis.max]
232    if {"" != $val && "" != $max} {
233        if {$val < $max} {
234            # tool specified this max -- don't go any higher
235            set max $val
236        }
237    }
238    return [list $min $max]
239}
240
241# ----------------------------------------------------------------------
242# USAGE: hints ?<keyword>?
243#
244# Returns a list of key/value pairs for various hints about plotting
245# this histogram.  If a particular <keyword> is specified, then it returns
246# the hint for that <keyword>, if it exists.
247# ----------------------------------------------------------------------
248itcl::body Rappture::Histogram::hints {{keyword ""}} {
249    if {![info exists _hints]} {
250        foreach {key path} {
251            group   about.group
252            label   about.label
253            color   about.color
254            style   about.style
255            type    about.type
256            xlabel  xaxis.label
257            xdesc   xaxis.description
258            xunits  xaxis.units
259            xorient xaxis.orientation
260            xscale  xaxis.scale
261            xmin    xaxis.min
262            xmax    xaxis.max
263            ylabel  yaxis.label
264            ydesc   yaxis.description
265            yunits  yaxis.units
266            yscale  yaxis.scale
267            ymin    yaxis.min
268            ymax    yaxis.max
269        } {
270            set str [$_hist get $path]
271            if {"" != $str} {
272                set _hints($key) $str
273            }
274        }
275
276        if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
277              && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
278            set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
279        }
280        if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
281              && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
282            set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
283        }
284
285        if {[info exists _hints(group)] && [info exists _hints(label)]} {
286            # pop-up help for each histogram
287            set _hints(tooltip) $_hints(label)
288        }
289    }
290
291    if {$keyword != ""} {
292        if {[info exists _hints($keyword)]} {
293            return $_hints($keyword)
294        }
295        return ""
296    }
297    return [array get _hints]
298}
299
300# ----------------------------------------------------------------------
301# USAGE: Build
302#
303# Used internally to build up the vector representation for the
304# histogram when the object is first constructed, or whenever the histogram
305# data changes.  Discards any existing vectors and builds everything
306# from scratch.
307# ----------------------------------------------------------------------
308itcl::body Rappture::Histogram::Build {} {
309    # discard any existing data
310    Clear
311    #
312    # Scan through the components of the histogram and create
313    # vectors for each part.  Right now there's only one
314    # component.  I left in the component tag in case future
315    # enhancements require more than one component.
316    #
317    foreach cname [$_hist children -type component] {
318        ParseData $cname
319    }
320    # Creates lists of x and y marker data.
321    set _xmarkers {}
322    set _ymarkers {}
323    foreach cname [$_hist children -type "marker" xaxis] {
324        set at     [$_hist get "xaxis.$cname.at"]
325        set label  [$_hist get "xaxis.$cname.label"]
326        set styles [$_hist get "xaxis.$cname.style"]
327        set data [list $at $label $styles]
328        lappend _xmarkers $data
329    }
330    foreach cname [$_hist children -type "marker" yaxis] {
331        set at     [$_hist get "yaxis.$cname.at"]
332        set label  [$_hist get "yaxis.$cname.label"]
333        set styles [$_hist get "yaxis.$cname.style"]
334        set data [list $at $label $styles]
335        lappend _xmarkers $data
336    }
337}
338
339#
340# ParseData --
341#
342#       Parse the components data representations.  The following
343#       elements may be used <xy>, <xhw>, <namevalue>, <xvector>,
344#       <yvector>.  Only one element is used for data. 
345#
346itcl::body Rappture::Histogram::ParseData { comp } {
347    # Create new vectors or discard any existing data
348    set _xvalues($comp) [blt::vector create \#auto]
349    set _yvalues($comp) [blt::vector create \#auto]
350    set _widths($comp) [blt::vector create \#auto]
351    set _xlabels($comp) {}
352
353    set xydata [$_hist get ${comp}.xy]
354    if { $xydata != "" } {
355        set count 0
356        foreach line [split $xydata \n] {
357            if {[llength $line] == 2} {
358                foreach {name value} $line break
359                $_yvalues($comp) append $value
360                $_xvalues($comp) append $count
361                lappend _xlabels($comp) $name
362                incr count
363            }
364        }           
365        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
366        return
367    }
368    set xhwdata [$_hist get ${comp}.xhw]
369    if { $xhwdata != "" } {
370        set count 0
371        foreach line [split $xhwdata \n] {
372            set n [scan $line {%s %s %s} name h w]
373            if {$n >= 2} {
374                lappend _xlabels($comp) $name
375                $_xvalues($comp) append $count
376                $_yvalues($comp) append $h
377                if { $n == 3 } {
378                    $_widths($comp) append $w
379                }
380                incr count
381            }
382        }           
383        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
384        return
385
386        # FIXME:  There must be a width specified for each bin location.
387        #         If this isn't true, we default to uniform widths
388        #         (zero-length _widths vector == uniform).
389        if { [$_xvalues($comp) length] != [$_widths($comp) length] } {
390            $_widths($comp) set {}
391        }
392        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
393        return
394    }
395    set xv [$_hist get $comp.xvector]
396    set yv [$_hist get $comp.yvector]
397    if { $xv != "" && $yv != "" } {
398        $_yvalues($comp) set $yv
399        $_xvalues($comp) seq 0 [$yv length]
400        set _xlabels($comp)
401    }
402    set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
403}
404
405itcl::body Rappture::Histogram::Clear { {comp ""} } {
406    if { $comp == "" } {
407        foreach name [array names _widths] {
408            blt::vector destroy $_widths($name)
409        }
410        array unset _widths
411        foreach name [array names _yvalues] {
412            blt::vector destroy $_yvalues($name)
413        }
414        array unset _yvalues
415        foreach name [array names _xvalues] {
416            blt::vector destroy $_xvalues($name)
417        }
418        array unset _xvalues
419        array unset _xlabels
420        array unset _comp2hist
421        return
422    }
423    if { [info exists _widths($comp)] } {
424        blt::vector destroy $_widths($comp)
425    }
426    if { [info exists _yvalues($comp)] } {
427        blt::vector destroy $_yvalues($comp)
428    }
429    if { [info exists _xvalues($comp)] } {
430        blt::vector destroy $_xvalues($comp)
431    }
432    array unset _xvalues $comp
433    array unset _yvalues $comp
434    array unset _widths $comp
435    array unset _xlabels $comp
436    array unset _comp2hist $comp
437}
438
Note: See TracBrowser for help on using the repository browser.