Updated 2016-08-09 18:59:24 by arjen

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 exprs 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 <Return> 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.
 package require Tk

 proc main {} {
    canvas .c -bg white -borderwidth 0
      bind .c <Motion> {displayXY .info %x %y}
    frame  .f
      label  .f.1 -text "f(x) = "
      entry  .f.f -textvar ::function -width 40
        bind .f.f <Return> {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 <Return>               {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

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
 set gwth 650
 set ghght 250
 set numtc 12
 set nxtc 8
 set pfnm [pwd]/pvt.csv
 set flatc SystemButtonFace
 set gblst {cnvs gwth ghght minx maxx miny \
            i numtc nxtc garr cgarr xscale yscale}
 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
 bind $w.filent <Button-3> {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 . <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 {
                    acos        cos     hypot   sinh    asin    cosh    log     sqrt
                    atan        exp     log10   tan     atan2   floor   pow     tanh
                    ceil        fmod    sin
                    -,+,~,!    *,/    +,-
                    <<,>>    <,>,<=,>=
                } -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}
        #bind . <Control-l> {exec wish83 protols.tcl $::pfnm}
        bind . <Control-l> {set fid [open "| wish83 protols.tcl $::pfnm" r+]}

See also A little graph plotter