source: trunk/kitgen/8.x/blt/pareto.tcl@ 190

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

namespace import blt::*

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