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
}
mainPT 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 <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 {
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}
}
#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
