[Keith Vetter] 2006-12-18 : Here's a little program that plots
cubic equations. It lets you tweak the values for the four
terms. I saw this as an applet and thought it would make a
fun little afternoon programming exercise.
------
[uniquename] 2013aug18
For those readers who do not have the time/opportunity/facilities/whatever
to run the code below, here is an image that shows the
nice-looking, nice-performing GUI that the code produces.
[vetter_CubicFunctionExplorer_wiki17383_screenshot_671x459.jpg]
In 'Animate' mode, the sliders for the 4 coefficients automatically
advance through their ranges (left-most scale moving fastest).
As the scales change, the curve updates (moves) immediately, alongd with the
coefficients of the equation shown on the graph. updates just as fast.
In 'Animate' mode,
the curve and the equation coefficients are updating
'like crazy'
(i.e. fast) --- and that's on my little netbook computer that people
insist is too weak to do anything but function as a paper weight or door stop.
------
======
##+##########################################################################
#
# cubic.tcl -- Displays the graph of some cubic equations
# by Keith Vetter, December 2006
#
# http://www.mathopenref.com/cubicexplorer.html
package require Tk
package require tile
array set S {title "Cubic Function Explorer" X 25 Y 5 bg #b4bacc eq #6466fc
go 0 delay 75}
array set MAX {a 4 b 5 c 25 d 25}
array set DIR {a 1 b 2 c 5 d 5}
foreach who {a b c d} {
set C($who) [expr {-$MAX($who) + int(rand()*2*$MAX($who))}]
}
proc DoDisplay {} {
global S MAX
wm title . $S(title)
label .title -text $S(title) -font {Times 36 bold}
frame .ctrl
canvas .c -relief sunken -bd 2 -bg $::S(bg)
foreach who {a b c d} {
label .ctrl.l$who -text $who -font {Helvetica 10 italic bold} -fg $S(eq)
label .ctrl.v$who -textvariable ::C(nice,$who) -width 3
::ttk::scale .ctrl.s$who -from $MAX($who) -to -$MAX($who) \
-variable ::C($who) -orient v -command NewValue
::ttk::button .ctrl.z$who -image ::img::star -command [list Zero $who] \
-takefocus 0
}
::ttk::button .anim -text Animate -command StartStop
::ttk::button .about -text About -command About
pack .title -side top -fill y
pack .ctrl -side right -fill y -pady {10 30} -padx {0 30}
pack .c -side left -fill both -expand 1 -pady {10 30} -padx 30
grid .ctrl.la .ctrl.lb .ctrl.lc .ctrl.ld
grid .ctrl.va .ctrl.vb .ctrl.vc .ctrl.vd
grid .ctrl.sa .ctrl.sb .ctrl.sc .ctrl.sd
grid .ctrl.za .ctrl.zb .ctrl.zc .ctrl.zd
grid .anim - - - -in .ctrl -row 100 -pady 5
grid .about - - - -in .ctrl -row 101
grid columnconfigure .ctrl {0 1 2 3} -weight 1
grid rowconfigure .ctrl 99 -weight 1
bind .c <Configure> {Recenter %W %h %w}
bind all <F2> {console show}
}
proc Recenter {W h w} {
set h [expr {$h / 2.0}] ; set w [expr {$w / 2.0}]
$W config -scrollregion [list -$w -$h $w $h]
DrawGrid
Plotit
}
proc NewValue {args} {
foreach who {a b c d} {
set ::C(nice,$who) [format %.1f $::C($who)]
}
Plotit
}
proc DrawGrid {} {
global S CLR
.c delete all
foreach {x0 y0 x1 y1} [.c cget -scrollregion] break
set fnt {Times 8}
for {set x 1} {1} {incr x} {
set cx [expr {$x * $S(X)}] ;# Scaled to canvas
if {$cx > $x1} break
.c create line $cx $y0 $cx $y1 -fill white
.c create line -$cx $y0 -$cx $y1 -fill white
set n [.c create text $cx 0 -text $x -fill white -anchor n -font $fnt]
.c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
.c raise $n
set n [.c create text -$cx 0 -text -$x -fill white -anchor n -font $fnt]
.c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
.c raise $n
}
for {set y 5} {1} {incr y 5} {
set cy [expr {$y * $S(Y)}] ;# Scaled to canvas
if {$cy > $y1} break
.c create line $x0 $cy $x1 $cy -fill white
.c create line $x0 -$cy $x1 -$cy -fill white
set n [.c create text -3 $cy -text -$y -fill white -anchor e -font $fnt]
.c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
.c raise $n
set n [.c create text -3 -$cy -text $y -fill white -anchor e -font $fnt]
.c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
.c raise $n
}
.c create line $x0 0 $x1 0 -fill blue
.c create line 0 $y0 0 $y1 -fill blue
.c create text [expr {$x0+20}] [expr {17.5*$S(Y)}] -tag equation \
-anchor w -font {Helvetica 10 bold italic} -fill $::S(eq)
}
proc Plotit {} {
global C S
.c delete plot
foreach {x0 y0 x1 y1} [.c cget -scrollregion] break
if {! [info exists x0]} return ;# Pre-update catch
set xy {}
for {set cx [expr {int($x0)}]} {$cx <= $x1} {incr cx} {
set x [expr {$cx / double($S(X))}]
set y [expr {$x * ($x * ($C(a)*$x + $C(b)) + $C(c)) + $C(d)}]
set cy [expr {-1*$y * $S(Y)}]
lappend xy $cx $cy
}
.c create line $xy -tag plot -fill red -width 2
.c itemconfig equation -text [GetEquation]
}
proc About {} {
set msg "$::S(title)\nby Keith Vetter, December 2006\n\n"
append msg "Visualization of the cubic equation"
tk_messageBox -message $msg -title "About $::S(title)"
}
proc Zero {who} {
set ::C($who) 0
NewValue
}
proc GetEquation {} {
global C
array set super {a x\u00b3 b x\u00b2 c x d ""}
set txt ""
foreach who {a b c d} {
set num [format %.1f $C($who)]
if {$num == 0} continue
set num2 [expr {int($num) == $num ? abs(int($num)) : abs($num)}]
if {$num2 == 1 && $who ne "d"} {set num2 ""}
if {$num > 0} {
if {$txt ne ""} { append txt " + "}
} else {
if {$txt eq ""} { append txt "-"} else {append txt " - "}
}
append txt $num2 $super($who)
}
if {$txt eq ""} {set txt 0}
return "y = $txt"
}
if {[lsearch [image names] ::img::star] == -1} {
image create bitmap ::img::star -data {
#define plus_width 7
#define plus_height 7
static char plus_bits[] = {
0x49, 0x2a, 0x1c, 0x7f, 0x1c, 0x2a, 0x49}
}
}
proc StartStop {} {
set ::S(go) [expr {$::S(go) ? 0 : -1}]
if {$::S(go)} Animate
}
proc Animate {{num ""}} {
global S C MAX DIR
if {$num ne ""} {set S(go) $num}
foreach who {a b c d} {
set next [expr {$C($who) + $DIR($who)}]
if {abs($next) <= $MAX($who)} {
set C($who) $next
break
}
set DIR($who) [expr {-$DIR($who)}]
}
after idle NewValue
if {$S(go) > 0} { incr S(go) -1 }
if {$S(go)} { after $S(delay) Animate }
}
DoDisplay
update
NewValue
after 200 Animate 20
return
======
----
[UK] you can find another implementation of this using BLT vector and graph in http://wiki.tcl.tk/15000 Example 3 ;-)
[KPV] don't know how I missed it :)
[UK] BLT is under appreciated, but for me it is still the first stop for rich plotting, vector math and tabsets.
----
<<categories>> Plotting