!!!!!! [WikiDbImage funplot.jpg] !!!!!! [Richard Suchenwirth] 2001-05-28 - My teenage daughter hates math. In order to motivate her, I beefed up [A little function plotter] which before only took one function, in strict Tcl (expr) notation, from the command line. Now there's an entry widget, and the accepted language has also been enriched: beyond ''expr''s rules, you can omit dollar and multiplication signs, like ''2x+1'', powers can be written as ''x3'' instead of ($x*$x*$x); in simple cases you can omit parens round function arguments, like ''sin x2''. Hitting in the entry widget displays the function's graph. If you need some ideas, click on the "?" button to cycle through a set of demo functions, from boring to bizarre (e.g. if ''rand()'' is used). Besides default scaling, you can zoom in or out. Moving the mouse pointer over the canvas displays x and y coordinates, and the display changes to white if you're on a point on the curve. The target was not reached: my daughter still hates math. But at least I had hours of Tcl (and function) fun again, surfing in the Cartesian plane... hope you enjoy it too! ---- A [starkit] version of this code is available on [sdarchive]. ---- [Jeff Smith] 2019-09-09 : Below is an online demo using [CloudTk] <> <> ---- ====== package require Tk proc main {} { canvas .c -bg white -borderwidth 0 bind .c {displayXY .info %x %y} frame .f label .f.1 -text "f(x) = " entry .f.f -textvar ::function -width 40 bind .f.f {plotf .c $::function} button .f.demo -text " ? " -pady 0 -command {demo .c} label .f.2 -text " Zoom: " entry .f.fac -textvar ::factor -width 4 set ::factor 32 bind .f.fac {zoom .c 1.0} button .f.plus -text " + " -pady 0 -command {zoom .c 2.0} button .f.minus -text " - " -pady 0 -command {zoom .c 0.5} eval pack [winfo children .f] -side left -fill both label .info -textvar ::info -just left pack .info .f -fill x -side bottom pack .c -fill both -expand 1 demo .c } set ::demos { "cos x3" 2 1-x 0.5x2 x3/5 "sin x" "sin x2" 1/x sqrt(x) "tan x/5" x+1/x x abs(x) "exp x" "log x" "log x2" round(x) "int x%2" "x-int x" "0.2tan x+1/tan x" x*(rand()-0.5) x2/5-1/(2x) "atan x" sqrt(1-x2) "abs(x-int(x*2))" (x-1)/(x+1) "sin x-tan x" "sin x-tan x2" "x-abs(int x)" 0.5x-1/x -0.5x3+x2+x-1 3*sin(2x) -0.05x4-0.2x3+1.5x2+2x-3 "9%int x" 0.5x2/(x3-3x2+4) "abs x2-3 int x" "int x%3" } proc displayXY {w cx cy} { set x [expr {double($cx-$::dx)/$::factor}] set y [expr {double(-$cy+$::dy)/$::factor}] set ::info [format "x=%.2f y=%.2f" $x $y] catch { $w config -fg [expr {abs([expr $::fun]-$y)<0.01?"white":"black"}] } ;# may divide by zero, or other illegal things } proc zoom {w howmuch} { set ::factor [expr round($::factor*$howmuch)] plotf $w $::function } proc plotf {w function} { foreach {re subst} { {([a-z]) +(x[0-9]?)} {\1(\2)} " " "" {([0-9])([a-z])} {\1*\2} x2 x*x x3 x*x*x x4 x*x*x*x x \$x {e\$xp} exp } {regsub -all $re $function $subst function} set ::fun $function set ::info "Tcl: expr $::fun" set color [lpick {red blue purple brown green}] plotline $w [fun2points $::fun] -fill $color } proc lpick L {lindex $L [expr {int(rand()*[llength $L])}]} proc fun2points {fun args} { array set opt {-from -10.0 -to 10.0 -step .01} array set opt $args set res "{" for {set x $opt(-from)} {$x<= $opt(-to)} {set x [expr {$x+$opt(-step)}]} { if {![catch {expr $fun} y]} { if {[info exists lasty] && abs($y-$lasty)>100} { append res "\} \{" ;# incontinuity } append res " $x $y" set lasty $y } else {append res "\} \{"} } append res "}" } proc plotline {w points args} { $w delete all foreach i $points { if {[llength $i]>2} {eval $w create line $i $args -tags f} } set fac $::factor $w scale all 0 0 $fac -$fac $w create line -10000 0 10000 0 ;# X axis $w create line 0 -10000 0 10000 ;# Y axis $w create line $fac 0 $fac -3 ;# x=1 tick $w create line -3 -$fac 0 -$fac ;# y=1 tick set ::dx [expr {[$w cget -width]/2}] set ::dy [expr {[$w cget -height]/2}] $w move all $::dx $::dy $w raise f } proc demo {w} { set ::function [lindex $::demos 0] ;# cycle through... set ::demos [concat [lrange $::demos 1 end] [list $::function]] set ::factor 32 plotf $w $::function } main ====== ---- [PT] 13-May-2003: This is fantastic! I wish I'd had one of these when I was at school. Great job. ---- 23-Oct-2011: I've created 2005 a version with little more GUI and "screen" management. It was very helpful when writing my diploma thesis, see [tkFPlot]. ---- [RR] 24Nov03: I had a similar idea because of a problem I had at work. Sometimes I get a set of x-y data. I can plot it, of course. There are ways to approximate the data with some polynomial or Fourier series. In some cases, however, that misses some (relatively) simple analytical formula which is actually a better fit to the data. So I built a little script that plots a file of (comma separated) x-y data. Then, using the same scales and intervals, plots a user-input formula (I ditched the '$' but still require Tcl syntax). Then, you can plot the difference. In practice, this has only been really useful a couple of times, but then it was quite useful! ====== # Function Analysis #-----------------------------------------------defaults set gwth 650 set ghght 250 set numtc 12 set nxtc 8 set pfnm [pwd]/pvt.csv set flatc SystemButtonFace #-----------------------------------------------globals set gblst {cnvs gwth ghght minx maxx miny \ i numtc nxtc garr cgarr xscale yscale} #-----------------------------------------------Main wm title . "Functional Analysis" wm deiconify . foreach f1 {1 2 3 4 5} { frame .$f1 -borderwidth 2 -relief groove pack .$f1 -side top -pady 1 foreach f2 {1 2 3 4} { frame .$f1.$f2 -borderwidth 4 pack .$f1.$f2 -side left } } set w .1.2 button $w.filebut -text Plot\nFile -command {graph 0 $pfnm $gblst} label $w.filelab -text "File: " entry $w.filent -textvariable pfnm -width 38 label $w.txt -text "text file of x,y pairs" pack $w.filebut $w.filelab -side left pack $w.txt $w.filent -side top bind $w.filent {graph 0 $pfnm $gblst} bind $w.filent { if [winfo exists .1.5] { destroy .1.5 } else { frame .1.5 -borderwidth 4 pack .1.5 -side top label .1.5.text -text "File of the type: ," pack .1.5.text } } bind $w.filent {set pfnm [tk_getOpenFile]} set w .4.2 set cnvs $w.gcvs1 frame $w.gp -borderwidth 4; pack $w.gp -side top set w .4.2.gp label $w.wdlab -text "Graph Width:" entry $w.wdent -textvariable gwth -relief flat -bg $flatc -width 8 label $w.htlab -text "Graph Height:" entry $w.htent -textvariable ghght -relief flat -bg $flatc -width 8 pack $w.wdlab $w.wdent $w.htlab $w.htent -side left bind . exit #-----------------------------------------------Plot difference proc diffPlt {gblst} { set cmd "global" foreach v $gblst {append cmd " $v"} eval $cmd for {set p 0} {$p < $i} {incr p} { set garr($p,y3) [expr $garr($p,y)-$garr($p,y2)] set cgarr($p,y3) [expr $ghght -($garr($p,y3)-$miny)*$yscale] } for {set p 1} {$p < $i} {incr p} { set q [expr $p -1] $cnvs create line $cgarr($q,x) $cgarr($q,y3) \ $cgarr($p,x) $cgarr($p,y3) -width 1 -fill #ff55aa } destroy .2.pfun .2.funlab .2.funent .2.difbut } #--------------------------------------------Plot file or function proc graph {flg fun gblst} { set cmd "global" foreach v $gblst {append cmd " $v"} eval $cmd if {$flg == 0} { destroy $cnvs canvas $cnvs -width $gwth -height $ghght \ -borderwidth 2 -relief sunken -bg white pack $cnvs -side bottom set c0y $ghght set c0x 0 set fid [open $fun r] set pvtlst [split [read $fid] \n] close $fid foreach ptpr $pvtlst { if {$ptpr != ""} {lappend pvtlst2 [split $ptpr ,]} };#---------------------------------------note: comma delimited set pvtlst [lsort -real -index 0 $pvtlst2];#---------------- set minx [lindex [lindex $pvtlst 0] 0] set numelems [llength $pvtlst] set lastelem [incr numelems -1] set maxx [lindex [lindex $pvtlst $lastelem] 0] # get all cartesian pairs to plot set i 0 foreach ptpair $pvtlst { set garr($i,x) [lindex $ptpair 0] set garr($i,y) [lindex $ptpair 1] incr i } #now "i" is the number of array elements since it starts w/ 0 and goes to i-1 # turn cartesian pairs into canvas coordinates # first find ymax and ymin set maxy $garr(0,y) set miny $garr(0,y) for {set p 1} {$p<$i} {incr p} { if {$garr($p,y)<$miny} then {set miny $garr($p,y)} if {$garr($p,y)>$maxy} then {set maxy $garr($p,y)} } set yscale [expr 1.00*$ghght/($maxy-$miny)] set xscale [expr 1.00*$gwth/($maxx-$minx)] for {set p 0} {$p < $i} {incr p} { set cgarr($p,x) [expr $c0x +($garr($p,x)-$minx)*$xscale] set cgarr($p,y) [expr $c0y -($garr($p,y)-$miny)*$yscale] } # create lines in canvas set c $cnvs # draw Yaxis set xmd [expr $gwth/2] set tcinc [expr $ghght/$numtc] $c create line $xmd $c0y $xmd 0 -width 1 -fill white for {set p 0} {$p<$numtc} {incr p} { set tcy [expr $ghght - $tcinc*$p] $c create line 0 $tcy $gwth $tcy -width 1 -fill grey set yval [format "%3.2f" [expr $miny+$p*$tcinc/$yscale]] $c create text $xmd $tcy -text $yval -fill grey } set xl [expr $gwth/($i*3)] $c create text $xl $tcinc -text $minx -fill grey -anchor w $c create text $gwth $tcinc -text $maxx -fill grey -anchor e set ntx [expr $nxtc - 1] set tcd [expr int($gwth/$ntx)] set xdl [expr int($maxx-$minx)/$ntx] incr ntx -1 for {set p 1} {$p<=$ntx} {incr p} { incr xl $tcd set xtx [expr {$minx+$p*$xdl}] $c create text $xl $tcinc -text $xtx -fill grey } for {set p 1} {$p < $i} {incr p} { set q [expr $p -1] $c create line $cgarr($q,x) $cgarr($q,y) $cgarr($p,x) $cgarr($p,y) -width 1 } set w .2.2 destroy $w.pfun $w.funlab $w.funent button $w.pfun -text Plot\nFunction \ -command {graph 1 $funstr $gblst} -fg blue label $w.funlab -text "enter function; tcl format; x is independent var." entry $w.funent -textvariable funstr -width 50 pack $w.pfun -side left -padx 6 pack $w.funlab $w.funent -side top bind $w.funent {graph 1 $funstr $gblst} bind $w.funent { if [winfo exists .5.5] { destroy .5.5 } else { frame .5.5 -borderwidth 4 pack .5.5 -side top label .5.5.text -text { FUNCTIONS acos cos hypot sinh asin cosh log sqrt atan exp log10 tan atan2 floor pow tanh ceil fmod sin OPERATORS -,+,~,! *,/ +,- <<,>> <,>,<=,>= ==,!=,&,^,|,&&,||,x?y:z } -justify left pack .5.5.text } } } else { for {set p 0} {$p<$i} {incr p} { # Assume that input function uses "x" as independant variable set fun2 [string map {x $garr($p,x)} $fun] # make sure "exp" function not clobberd set fun2 [string map {e$garr($p,x)p exp} $fun2] set garr($p,y2) [expr $fun2] } for {set p 0} {$p < $i} {incr p} { set cgarr($p,y2) [expr {$ghght -($garr($p,y2)-$miny)*$yscale}] } for {set p 1} {$p < $i} {incr p} { set q [expr $p -1] $cnvs create line $cgarr($q,x) $cgarr($q,y2) \ $cgarr($p,x) $cgarr($p,y2) -width 1 -fill blue } set w .2.2 destroy $w.difbut button $w.difbut -text "Plot (file-minus-function)" \ -command {diffPlt $gblst} -fg red pack $w.difbut -side bottom -pady 4 bind $w.difbut {diffPlt $gblst} } #bind . {exec wish83 protols.tcl $::pfnm} bind . {set fid [open "| wish83 protols.tcl $::pfnm" r+]} } ====== ---- See also [A little graph plotter] <> Arts and crafts of Tcl-Tk programming | Mathematics | Graphics | Application | Plotting