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 { } } { child2 c2-sum { .....} } ...} ====== ######################################################################## # # Radial Hierarchical Pareto # namespace eval redialHeirPareto { option add *RedialHeirPareto.size 400 option add *RedialHeirPareto.core 20 option add *RedialHeirPareto.maxLevels 10 option add *RedialHeirPareto.relief flat option add *RedialHeirPareto.borderWidth 0 option add *RedialHeirPareto.Canvas.width 200m option add *RedialHeirPareto.Canvas.height 200m option add *RedialHeirPareto.Canvas.background gray option add *RedialHeirPareto.Canvas.foreground black option add *RedialHeirPareto.Canvas.highlightThickness 0 option add *RedialHeirPareto.Canvas.borderWidth 1 option add *RedialHeirPareto.Canvas.relief raised } proc redialHeirPareto::constructor { widget top hTreeName } { upvar $hTreeName hTree frame $widget -class RedialHeirPareto canvas [set c $widget.canvas] pack $c -fill both -expand true option add ${widget}.hTreeName $hTreeName 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] { foreach {name lvl startAngle arcAngle val} $sl {break} # 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 [bind Text ] 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 # event. Does not maximize to full window. proc redialHeirPareto::fit {c} { set bbox [$c bbox all] foreach {x0 y0 x1 y1} $bbox {break} 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 {} foreach {top sum children} $hTree {break} if {![llength $children]} {return ""} set anglePerUnit [expr 1.0*($stopAngle - $startAngle) / $sum] set angle $startAngle foreach child [lsort -decreasing -index 1 -real $children] { foreach {name val} $child {break} 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 [list redialHeirPareto::cballoon_disp $w $text] $w bind all [list after 1 $w delete cballoon] } proc redialHeirPareto::cballoon_disp {w text} { foreach {- - x y} [$w bbox current] break if [info exists y] { set id [$w create text $x $y -text $text -tag cballoon] foreach {x0 y0 x1 y1} [$w bbox $id] break $w create rect $x0 $y0 $x1 $y1 -fill lightyellow -tag cballoon $w raise $id } } ====== [Category Plotting] ---- [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! ---- !!!!!! %| Plotting |% !!!!!!