A little function plotter

See Fun with functions for a quite improved version (still little ;-)


Richard Suchenwirth 2001-06-05 -- 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.


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 <Return> {graph 0 $pfnm $gblst}
 bind $w.filent <F1> {
    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: <x value>,<y value>"
        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 . <Escape> 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 <Return> {graph 1 $funstr $gblst}
        bind $w.funent <F1> {
            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 <Return> {diffPlt $gblst}
    }
 }