See [Fun with functions] for a quite improved version (still little ;-) ---- [Richard Suchenwirth] -- Of course there is BLT, but Tcl is just such a great wheel reinvention tool ;-) Somebody asked on comp.lang.tcl whether there's software for plotting functions, and I just needed a little challenge. So here it is: ''fun2points'' tabulates x/y values for a given function, ''plotpoints'' draws, scales, and moves such a tabulated function (or whatever other x/y coordinates - stock quotes over time?) on a given canvas, and some wrapping lines as usage example. Sheer fun... #!/bin/sh # next lines restarts \ exec wish "$0" ${1+"$@"} proc fun2points {fun args} { array set opt { -from -4.0 -to 4.0 -step .1 } array set opt $args set res [list] for {set x $opt(-from)} {$x <= $opt(-to)} {set x [expr {$x+$opt(-step)}]} { if {![catch {expr $fun} y]} {lappend res $x $y} } set res } proc plotpoints {w points args} { eval $w create line $points $args set maxx [set minx [lindex $points 0]] set maxy [set miny [lindex $points 1]] foreach {x y} $points { if {$x<$minx} {set minx $x} if {$x>$maxx} {set maxx $x} if {$y<$miny} {set miny $y} if {$y>$maxy} {set maxy $y} } $w create line $minx 0 $maxx 0 $w create line 0 $miny 0 $maxy set xfac [expr 0.95*[$w cget -width]/($maxx-$minx)] set yfac [expr 0.95*[$w cget -height]/($maxy-$miny)] $w scale all 0 0 $xfac -$yfac foreach {minxc minyc} [$w bbox all] break $w move all [expr -$minxc+5] [expr -$minyc+5] } set fun [lindex $argv 0] pack [canvas .c] plotpoints .c [fun2points $fun] -fill red wm title . $fun # usage example: funplot.tcl 'sin($x)' ---- Here are actually some problems. This script probably runs on UNIX, but not on Windows 2000. I had to change it to the following form to be able to run it from the wish. #!/bin/sh # next lines restarts \ # the following line doesn't do anything under windows, does it? # exec wish "$0" ${1+"$@"} proc fun2points {fun args} { array set opt { -from -4.0 -to 4.0 -step .1 } array set opt $args set res [list] for {set x $opt(-from)} {$x <= $opt(-to)} {set x [expr {$x+$opt(-step)}]} { # i had to exchange the following line: # if {![catch {expr $fun} y]} {lappend res $x $y} set func $fun append func ($x) lappend res $x [expr $func] } set res } proc plotpoints {w points args} { eval $w create line $points $args set maxx [set minx [lindex $points 0]] set maxy [set miny [lindex $points 1]] foreach {x y} $points { if {$x<$minx} {set minx $x} if {$x>$maxx} {set maxx $x} if {$y<$miny} {set miny $y} if {$y>$maxy} {set maxy $y} } $w create line $minx 0 $maxx 0 $w create line 0 $miny 0 $maxy set xfac [expr 0.95*[$w cget -width]/($maxx-$minx)] set yfac [expr 0.95*[$w cget -height]/($maxy-$miny)] $w scale all 0 0 $xfac -$yfac foreach {minxc minyc} [$w bbox all] break $w move all [expr -$minxc+5] [expr -$minyc+5] } proc funplot {argv} { set fun [lindex $argv 0] if {[winfo exists .c]} {destroy .c} pack [canvas .c] plotpoints .c [fun2points $fun] -fill red wm title . $fun } # i also had to exchange the usage # usage example: funplot sin There is something very weird also: x should run up to 4.0 in this example, but it runs only to 3.9 :-( ''Does anyone understand this, please?'' Yes - comparing doubles is [a real problem]. Since I just wanted to cover the range from -Pi to +Pi, I didn't look that hard, but you're right, and can isolate the problem to expr {3.9+.01>1.0} which returns 1. so a cleaner test condition would have been for ... {($x-$opt(-to))<0.00001} ... or another delta that bridges the gap between real and evident - [RS] ---- BLT is at http://www.tcltk.com/blt/ . See also emu-graph, padgraph at http://www.shlrc.mq.edu.au/~steve/tcl ---- Here's a little functional analysis version: Let's say you have a file of x,y pairs: -24,-21.73388069 -23,-19.4630693 -22,-0.194728804 -21,17.56976841 -20,18.25890501 -19,3 -18,-13.51777044 -17,-16.34375736 -16,-4.606453067 -15,9.754317602 -14,13.86850298 -13,5.462171479 -12,-6.438875016 -11,-6.438875016 -10,-5.440211109 -9,3.709066367 -8,17.914865973 -7,4.598906191 -6,-1.676492989 -5,-4.794621373 -4,-3.027209981 -3,0.5 -2,1.818594854 -1,0.841470985 1,0.841470985 2,1.818594854 3,0.423360024 4,-3.027209981 5,-4.794621373 6,-1.676492989 7,4.598906191 9,3.709066367 10,-5.440211109 11,-10.99989227 12,-6.438875016 13,5.462171479 14,13.86850298 15,9.754317602 16,-4.606453067 17,-16.34375736 18,-13.51777044 19,2.847666984 20,18.25890501 21,17.56976841 22,-0.194728804 23,-19.4630693 24,-21.73388069 25,-3.308793752 26,19.82651971 27,25.82215007 28,7.585362073 29,-19.24538264 30,-29.64094872 31,-12.52516701 32,17.2 34,18 35,-15 36,-35.70403872 37,-23.81091093 38,11.26200599 39,37.58802007 40,30 41,-6.503529421 42,-38.49390501 15.5,-6 from some data source. You want to plot them and then see if you can match the plot with an analytical function (rather than fit a taylor series or fourier series digitally). # Function Analysis #-----------------------------------------------defaults set gwth 650 set ghght 180 set numtc 12 set nxtc 8 set pfnm [pwd]/pvt.csv #-----------------------------------------------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 } } 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 grey -width 8 label $w.htlab -text "Graph Height:" entry $w.htent -textvariable ghght -relief flat -bg grey -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} } } ---- [Category Mathematics]