Searching the house for the third $100 scientific calculator to be lost this year, so my son could complete his homework, I gave up and knocked together the following little doohickey, just ripe for extension.

I'm sure there are more full-featured ones out there, but this is quite handy in that it'll let you enter functions in the form

y=x^2 or y=x**2 or y=3x^2
i.e. no need to enter perl magic sigils, and the use of ^ as exponentiation (sorry if you needed exclusive-or - this ain't that kind of cal!). Oh, it also supports 'pi', for trigonometric functions, and multiplicands do not need the * sign, as long as the first is a number.

*dreams of a scientific calculator with built-in perl interpreter*

#!/usr/bin/perl -wT use strict; use constant pi => 3.14159265358979; use Tk; my $top = new MainWindow(-width => 800, -height => 600); my $cvs = $top->Canvas(-width => 800, -height => 550); my $frm = $top->Canvas(-width => 800, -height => 20); my $txt = $frm->Entry(-width => 40); my $min = $frm->Entry(-width => 5); my $max = $frm->Entry(-width => 5); my $stp = $frm->Entry(-width => 5); my $clr = $frm->Button(-text => 'Clear'); $clr->bind('<Button-1>' => [ sub { $cvs->delete($_) for $cvs->find('al +l') } ]); $txt->bind('<KeyPress-Return>', [ \&evaluate ]); $frm->pack(-side => 'bottom'); $min->pack(-side => 'left'); $max->pack(-side => 'left'); $stp->pack(-side => 'left'); $clr->pack(-side => 'right'); $txt->pack(-side => 'right'); $cvs->pack(-side => 'top'); $min->insert(0, "0"); $max->insert(0, "100"); $stp->insert(0, "1"); MainLoop; sub evaluate { my $text = $txt->get(); my $func = lc $text; $func =~ s/(\d+)(pi|x)/$1 * $2/g; $func =~ s/([xy])/\$$1/g; $func =~ s/\^/**/g; my $minx = $min->get(); my $maxx = $max->get(); my $step = $stp->get(); my $size = 1; for (my $x = $minx; $x <= $maxx; $x += $step) { my $y; eval "$func"; # warn "$func: $x, $y\n" if !($x % 50); $cvs->createRectangle( 800 * $x/$maxx, 300 - $y, 800 * $x/$maxx + $size, 300 - $y + $size, -width => 1); } $txt->delete(0, length $text); } __END__

Replies are listed 'Best First'.
Re: Cheap'n'cheerful Graph Drawer
by eric256 (Parson) on Jan 28, 2005 at 18:28 UTC

    Cool. You might look at Tk::WorldCanvas. It does some scaling (and looks like scrolling work for you). I also changed it to use an actual line tool instead of points, and smooth the line. Makes for some nice graphs.

    #!/usr/bin/perl -w use strict; use constant pi => 3.14159265358979; use Tk; use Tk::WorldCanvas; my $top = new MainWindow( -width => 800, -height => 600 ); my $cvs = $top->WorldCanvas( -width => 800, -height => 550 ); $cvs->center( 0, 0 ); my $frm = $top->Canvas( -width => 800, -height => 20 ); my $txt = $frm->Entry( -width => 40 ); my $min = $frm->Entry( -width => 5 ); my $max = $frm->Entry( -width => 5 ); my $stp = $frm->Entry( -width => 5 ); my $clr = $frm->Button( -text => 'Clear' ); $clr->bind( '<Button-1>' => [ sub { $cvs->delete($_) for $cvs->find('all') } ] + ); $txt->bind( '<KeyPress-Return>', [ \&evaluate ] ); $frm->pack( -side => 'bottom' ); $min->pack( -side => 'left' ); $max->pack( -side => 'left' ); $stp->pack( -side => 'left' ); $clr->pack( -side => 'right' ); $txt->pack( -side => 'right' ); $cvs->pack( -side => 'top' ); $min->insert( 0, "0" ); $max->insert( 0, "100" ); $stp->insert( 0, "1" ); MainLoop; sub evaluate { my $text = $txt->get(); my $func = lc $text; $func =~ s/(\d+)(pi|x)/$1 * $2/g; $func =~ s/([xy])/\$$1/g; $func =~ s/\^/**/g; my $mini = $min->get(); my $maxi = $max->get(); my $step = $stp->get(); #my $size = 1; my @points = (); for ( my $i = $mini ; $i <= $maxi ; $i += $step ) { my $y = 0; my $x = $i; eval "$func"; # warn "$func: $x, $y\n" if !($x % 50); push @points, $x, $y; # $cvs->createRectangle( # 800 * $x/$maxx, 300 - $y, # 800 * $x/$maxx + $size, 300 - $y + $size, # -width => 1); } $cvs->createLine( @points, -smooth => 1 ); $cvs->viewFit('all'); } __END__


    ___________
    Eric Hodges
Re: Cheap'n'cheerful Graph Drawer
by Mr. Muskrat (Canon) on Jan 29, 2005 at 08:46 UTC

    I've expanded upon the work of both moot and eric256. It's still pretty basic but adds a few additional features: colored lines, scroll bars, zoom, centering and error trapping/reporting. Since it uses Math::Trig, you can use any of its trigonometric functions.

    To zoom in, click the left mouse button over the graph. To zoom out, click the right mouse button over the graph. To center on a point, click the middle mouse button over the spot that be at the center of the graph.

    Enjoy!

    Update: I've added the ability to redraw the axes based on the values in X Min, X Max, and Step (there is no input validation for these yet). The axes subroutine still needs some work too.

    Update: Posted the correct refactoring attempt that doesn't use $x_axis, $y_axis or @ticks.

    #!/usr/bin/perl use strict; use warnings; use Tk; use Tk::WorldCanvas; require Tk::Dialog; use Graphics::ColorNames; use Math::Trig; # define our color set my $colors = Graphics::ColorNames->new( 'HTML' ); my %colors = %{ $colors->{SCHEMES}[0] }; delete $colors{fuscia}; # this is the misspelling of fuschia delete $colors{black}; # color of our axes delete $colors{white}; # kind of hard to see delete $colors{silver}; # kind of hard to see delete $colors{gray}; # kind of hard to see my @colors = keys %colors; # array of colors for the lines my $maxcolors = @colors; # mod the line count with this later my @IDs; # store line IDs so that we can delete them without removing +axes # main window my $top = new MainWindow(-width => 800, -height => 600, -title => 'Gra +phing Calculator'); # dialog box for error messages my $d = $top->DialogBox(-title => "Calculation Error", -buttons => ["O +K"]); # scrolled worldcanvas # left mouse click zooms in, middle mouse click centers, right mouse c +lick zooms out my $cvs = $top->Scrolled('WorldCanvas', -scrollbars => 'se', -width => + 800, -height => 550); $cvs->CanvasBind('<1>' => sub { $cvs->zoom(1.25) }); $cvs->CanvasBind('<3>' => sub { $cvs->zoom(0.8) }); $cvs->CanvasBind('<2>' => sub { $cvs->CanvasFocus; $cvs->center($cvs-> +eventLocation) }); # normal canvas with labels and text entries my $frm = $top->Canvas(-width => 800, -height => 20); my $txt_txt = $frm->Label(-text => 'Expression'); my $txt = $frm->Entry(-width => 40); my $min_txt = $frm->Label(-text => 'X Min'); my $min = $frm->Entry(-width => 5); my $max_txt = $frm->Label(-text => 'X Max'); my $max = $frm->Entry(-width => 5); my $stp_txt = $frm->Label(-text => 'Step'); my $stp = $frm->Entry(-width => 5 ); my $redraw = $frm->Button(-text => 'Redraw Axes', -command => [ \&axes + ]); my $clr = $frm->Button(-text => 'Clear', -command => [ sub { $cvs->de +lete(@IDs); @IDs = (); } ]); # bind the enter key to call the evaluate subroutine $txt->bind('<KeyPress-Return>', [ \&evaluate ]); # form up $frm->pack(-side => 'bottom'); $min_txt->pack(-side => 'left'); $min->pack(-side => 'left'); $max_txt->pack(-side => 'left'); $max->pack(-side => 'left'); $stp_txt->pack(-side => 'left'); $stp->pack(-side => 'left'); $redraw->pack(-side => 'left'); $txt_txt->pack(-side => 'left'); $clr->pack(-side => 'right'); $txt->pack(-side => 'right'); $cvs->pack(-side => 'top'); # preload our text boxes $min->insert(0, "0"); $max->insert(0, "100"); $stp->insert(0, "1"); axes(); MainLoop; sub evaluate { my $text = $txt->get(); my $func = lc $text; $func =~ s/(\d+)(pi|x)/$1 * $2/g; $func =~ s/([xy])/\$$1/g; $func =~ s/\^/**/g; my $mini = $min->get(); my $maxi = $max->get(); my $step = $stp->get(); # what's our new color? my $color = $colors->hex($colors[@IDs % $maxcolors], '#'); my @errors; my @points; for ( my $i = $mini ; $i <= $maxi ; $i += $step ) { my $y = 0; my $x = $i; eval "$func"; if ($@) { # do we have an eval error? # strip the ' at (eval XXX) line XXX' part of the error $@ =~ s/ at \(eval \d+\) line \d+//; push @errors, "$@\n"; } # only graph real points if ( $y =~ /i/ ) { push @errors, "Calculation '$text' resulted in y containing an i +maginary number."; } else { push @points, $x, $y; } } if ( @errors ) { # create dialog box with errors # if there are more than 5, only show the first one my $errors = @errors; my $msg; if ( @errors > 5 ) { $msg = "Showing only the first of $errors errors:\n$errors[0]"; } else { $msg = join( "\n", @errors ); } my $DialogRef = $top->Dialog( -title => 'Calculation Error', -text => $msg, -bitmap => 'warning', -buttons => [ 'OK' ], ); my $selected = $DialogRef->Show(); # I don't use $selected but may + in the future } else { # no errors # create the line and grab the ID my $ID = $cvs->createLine( @points, -smooth => 1, -fill => $color +); # keep track of all IDs so that we can delete them push( @IDs, $ID ); $cvs->viewFit( @IDs ); } } sub axes { $cvs->delete('all'); my $minx = $min->get(); my $maxx = $max->get(); my $step = $stp->get(); my $tick = (abs($minx) + abs($maxx)) / 10; my $maxi = 2 * $maxx; my $mini = -$maxi; my $scale = 10 * $step / $tick; $cvs->createLine($mini, 0, $maxi, 0); $cvs->createLine(0, $mini, 0, $maxi); for ( my $i = $mini; $i <= $maxi; $i += $tick ) { $cvs->createLine($i, -$scale, $i, $scale); $cvs->createLine(-$scale, $i, $scale, $i); } }
      When I first ran your code, I got:
      Global symbol "$x_axis" requires explicit package name at ./426208.pl +line 152. Global symbol "$y_axis" requires explicit package name at ./426208.pl +line 153. Global symbol "@ticks" requires explicit package name at ./426208.pl l +ine 155.
      After putting a few "my" 's in there, it works nice. Very clever axis shifting.

      I'm not really a human, but I play one on earth. flash japh

        D'oh! I posted the wrong refactoring attempt. I'll update it again.

Re: Cheap'n'cheerful Graph Drawer
by zentara (Cardinal) on Jan 28, 2005 at 19:37 UTC
    There are a couple of "ready-made graph equation visualizers" already made for Tk.

    Check out the widget demo, and look for "7. Plot a series of continuous functions on a Perl/Tk Canvas.". You can easily make it a stand-alone application.

    Or go to tkgnuplot and get a nice one.

    That will really impress your kid. :-)


    I'm not really a human, but I play one on earth. flash japh

      The pointer to tkgnuplot is useful -- I've just been using plain ol' gnuplot for such things. I guess I can't see how the OP is improving on the gnuplot interface, but the tkgnuplot version is pretty nice.

      radiantmatrix
      require General::Disclaimer;
      s//2fde04abe76c036c9074586c1/; while(m/(.)/g){print substr(' ,JPacehklnorstu',hex($1),1)}

Re: Cheap'n'cheerful Graph Drawer
by mawe (Hermit) on Jan 28, 2005 at 15:55 UTC
    Hi!

    Nice, but $y stays uninitialized. I guess it should be $y = eval "$func";

    EDIT: I should read the description before I post a comment ;-)

    Regards, mawe

      Enter your function in the form
      y = mx+c
      not just
      mx+c
      $y gets initialised in the eval.