I run into data graphing challenge: How to effectively draw a Pareto graph showing how a contributions are summed into a global sum in hierarchical manner.

The following is a widget that accepts a "tree" of the form: { topName totalSum { {child1 c1-sum { <c1-children list> } } { child2 c2-sum { .....} } ...}

```########################################################################
#
#

namespace eval redialHeirPareto {

}

proc redialHeirPareto::constructor { widget top hTreeName } {
upvar      \$hTreeName hTree

frame \$widget -class RedialHeirPareto
canvas [set c \$widget.canvas]
pack \$c -fill both -expand true

set size    [option get \$widget size      RedialHeirPareto]
set numLvls [option get \$widget maxLevels RedialHeirPareto]
set cH      [option get \$widget core      RedialHeirPareto]

set dH [expr (\$size / 2.0 - \$cH)/\$numLvls]
set mx \$size
set my \$size

# draw the hierarchies
for {set h [expr \$cH + \$dH]} {\$h <= \$size / 2.0} {set h [expr \$h + \$dH]} {
\$c create oval \
[expr \$mx - \$h] [expr \$my - \$h] [expr \$mx + \$h] [expr \$my + \$h] \
-outline black
}

# obtain the layout for each cell
set objs [calcObjLayout \$hTree]

# now draw them
foreach sl [lsort -index 1 -decreasing -integer \$objs] {
lassign \$sl name lvl startAngle arcAngle val
# first calc the box:
set r [expr \$cH + \$lvl*\$dH]
set x0 [expr \$mx - \$r]
set y0 [expr \$my - \$r]
set x1 [expr \$mx + \$r]
set y1 [expr \$mx + \$r]

set color [getColor \$arcAngle]
set id [\$c create arc \$x0 \$y0 \$x1 \$y1 \
-start \$startAngle -extent \$arcAngle \
-style pieslice -outline blue -fill \$color]

cballoon \$c \$id "\$name \$val"
}

# draw middle cicrle
\$c create oval \
[expr \$mx - \$cH] [expr \$my - \$cH] [expr \$mx + \$cH] [expr \$my + \$cH] \
-outline black -fill black

\$c create text \$mx \$my -anchor center -justify center -text \$top -fill yellow

bind \$c <2> [bind Text <2>]
bind \$c <B2-Motion> [bind Text <B2-Motion>]
fit \$c

frame [set help \$widget.help]
label \$help.l -text "Use: button-1 to show object properties and button-2 to drag"
pack \$help.l -fill both -expand true
pack \$help -fill both -expand true -side bottom

return \$widget
}

# This needs more work as it has bugs if run within the <Configure>
# event. Does not maximize to full window.
proc redialHeirPareto::fit {c} {
set bbox [\$c bbox all]
lassign \$bbox x0 y0 x1 y1
set mx [expr (\$x1 + \$x0)/2]
set my [expr (\$y1 + \$y0)/2]
set dx [expr \$x1 - \$x0]
set dy [expr \$y1 - \$y0]
set w  [\$c cget -width]
set h  [\$c cget -height]
\$c xview moveto 0
\$c yview moveto 0
#        \$c configure -scrollregion [list 0 0 \$w \$h]
#        set vw [lindex [\$c xview] 1]
#        set vh [lindex [\$c yview] 1]
#        if {\$vw != 0 && \$vh != 0} {
#                set w [expr \$w*\$vw]
#                set h [expr \$h*\$vh]
#   }
\$c scale all [expr 1.0*\$mx*\$w/\$dx] [expr 1.0*\$my*\$h / \$dy] [expr 1.0*\$w / \$dx] [expr 1.0*\$h / \$dy]
}

proc redialHeirPareto::getColor {arcAngle} {
set color [format "#%02x%02x%02x" 255 [expr 255-int(255*(\$arcAngle/360))] 0]
}

# Calculate the allocated start stop angle for each object
# The result is a list of {key lvl startAngle stopAngle}
proc redialHeirPareto::calcObjLayout {hTree {startAngle 0} {stopAngle 359} {lvl 1} } {
set res {}
lassign \$hTree top sum children

if {![llength \$children]} {return ""}

set anglePerUnit [expr 1.0*(\$stopAngle - \$startAngle) / \$sum]
set angle \$startAngle

foreach child [lsort -decreasing -index 1 -real \$children] {
lassign \$child name val
set endAngle [expr \$angle + \$anglePerUnit * \$val]
set a1 [expr \$anglePerUnit * \$val]
lappend res [list \$name \$lvl \$angle \$a1 \$val]
append res " " [calcObjLayout \$child \$angle \$endAngle [expr \$lvl + 1]]
set angle \$endAngle
}
return \$res
}

proc redialHeirPareto::cballoon {w tag text} {
\$w bind \$tag <ButtonPress-1> [list redialHeirPareto::cballoon_disp \$w \$text]
\$w bind all  <ButtonRelease-1> [list after 1 \$w delete cballoon]
}

proc redialHeirPareto::cballoon_disp {w text} {
lassign [\$w bbox current] - - x y
if [info exists y] {
set id [\$w create text \$x \$y -text \$text -tag cballoon]
lassign [\$w bbox \$id] x0 y0 x1 y1
\$w create rect \$x0 \$y0 \$x1 \$y1 -fill lightyellow -tag cballoon
\$w raise \$id
}
}```

AM (11 february 2008) Could you add an example that is not too trivial? It seems interesting enough :). (By the way: you have consistently used "redial" instead of "radial")

aspect: updated formatting. Not entirely sure how to use this -- if someone could add an example that would be great!

EG: you should Brace your expr-essions

 Category Plotting