Version 16 of Pareto with BLT

Updated 2007-04-26 23:36:15 by jorge

from Tcl Discussion group: I am including it here as it is not part of the demos.

 package require BLT 
 # -------------------------------------------------------------------------- 
 # Starting with Tcl 8.x, the BLT commands are stored in their own 
 # namespace called "blt". The idea is to prevent name clashes with 
 # Tcl commands and variables from other packages, such as a "table" 
 # command in two different packages. 
 # 
 # You can access the BLT commands in a couple of ways. You can prefix 
 # all the BLT commands with the namespace qualifier "blt::" 
 # 
 # blt::graph .g 
 # blt::table . .g -resize both 
 # 
 # or you can import all the command into the global namespace. 
 # 
 # namespace import blt::* 
 # graph .g 
 # table . .g -resize both 
 # 
 # -------------------------------------------------------------------------- 
 if { $tcl_version >= 8.0 } { 
    namespace import blt::* 
    namespace import -force blt::tile::* 
 } 

 # 
 # Example of a pareto chart. 
 # 
 barchart .b \
 -title "Defects Found During Inspection" \
 -font {Helvetica 12} \
 -plotpady { 12 4 } 
 table . .b -fill both 
 set data { 
 "Spot Weld" 82 yellow 
 "Lathe" 49 orange 
 "Gear Cut" 38 green 
 "Drill" 24 blue 
 "Grind" 17 red 
 "Lapping" 12 brown 
 "Press" 8 purple 
 "De-burr" 4 pink 
 "Packaging" 3 cyan 
 "Other" 12 magenta 
 } 

 # Create an X-Y graph line element to trace the accumulated defects. 
 .b line create accum -label "" -symbol none -color red 
 # Define a bitmap to be used to stipple the background of each bar. 
 bitmap define pattern1 { {4 4} {01 02 04 08} } 
 # For each process, create a bar element to display the magnitude. 
 set count 0 
 set sum 0 
 set ydata 0 
 set xdata 0 
 foreach { label value color } $data { 
 incr count 
 .b element create $label -xdata $count -ydata $value \
 -fg $color -relief solid -bd 1 -stipple pattern1 -bg lightblue 
 set labels($count) $label 
 # Keep a running total of defects 
 set sum [expr $value + $sum] 
 lappend ydata $sum 
 lappend xdata $count 
 } 

 # Configure the coordinates of the accumulated defects, 
 # now that we know what they are. 
 .b line configure accum -xdata $xdata -ydata $ydata 
 # Add text markers to label the percentage of total at each point. 
 foreach x $xdata y $ydata { 
 set percent [expr ($y * 100.0) / $sum] 
 if { $x == 0 } { 
 set text "0%" 
 } else { 
 set text [format %.1f $percent] 
 } 
 .b marker create text \
 -coords "$x $y" \
 -text $text \
 -anchor c \
 -yoffset -5 
 } 

 # Display an auxillary y-axis for percentages. 
 .b axis configure y2 \
 -hide no \
 -min 0.0 \
 -max 100.0 \
 -title "Percentage" 
 # Title the y-axis 
 .b axis configure y -title "Defects" 
 # Configure the x-axis to display the process names, instead of numbers. 
 .b axis configure x \
 -title "Process" \
 -command FormatLabels \
 -rotate 90 \
 -subdivisions 0 

 proc FormatLabels { widget value } { 
 global labels 
 set value [expr round($value)] 
 if {[info exists labels($value)] } { 
 return $labels($value) 
 } 

 return $value 
 } 

 # No legend needed. 
 .b legend configure -hide yes 
 # Configure the grid lines. 
 .b grid configure -mapx x -color lightblue