/usr/share/blt2.4/examples/pareto.tcl is in blt-demo 2.4z-4.2ubuntu1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | #!/usr/bin/wish
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.
#
# The pareto chart mixes line and bar elements in the same graph.
# Each processing operating is represented by a bar element. The
# total accumulated defects is displayed with a single line element.
barchart .b \
-title "Defects Found During Inspection" \
-font {Helvetica 12} \
-plotpady { 12 4 } \
-width 6i \
-height 5i
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 \
-borderwidth 1 \
-stipple pattern1 \
-bg lightblue
set labels($count) $label
# Get the total number 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 \
-font {Helvetica 10} \
-fg red4 \
-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
|