Category: Utility Scripts
Author/Contact Info David Hisel hiseldl
Description: This script is a user interface for comparing short snippets of code and was inspired by BrowserUk, bronto, and Aristotle at this node. There are several other nodes that have discussions about performance and using the Benchmark module, this is just the last one I read that made me want to write this code.

There are 2 buttons, 4 text widgets in which to enter text, 1 text widget to show the output, and an adjuster.

  • Clear Button - clears all the text boxes and reset's the count to 1000.
  • Run Button - runs the tests using cmpthese from the Benchmark module. The output text widget will be cleared before the test is run, you can turn this off by commenting out the following line in the OnRun method: 
    $tk{output_text}->delete(0.1, 'end');
  • count - this is the first argument to cmpthese.
  • test1 - this is the first snippet to be tested. An example: 
    mapgen    => 'my @ones = mapgen 1, 1000;'
  • test2 - this is the second snippet to be tested. An example: 
    xgen    => 'my @ones = xgen 1, 1000;'
  • code - this is where any supporting code should be typed; this field is not required. An example: 
    sub mapgen    { return map $_[0], (1..$_[1]); }
sub xgen    { return ($_[0]) x $_[1]; }
  • output - this is where the output from cmpthese will appear as well as the code that was eval'd. An example: 
    COUNT=1000
TEST CODE:
{mapgen    => 'my @ones = mapgen 1, 1000;',
xgen    => 'my @ones = xgen 1, 1000;',}
SUPPORT CODE:
sub mapgen    { return map $_[0], (1..$_[1]); }
sub xgen    { return ($_[0]) x $_[1]; }

RESULTS:
Benchmark: timing 1000 iterations of mapgen, xgen...
    mapgen:  2 wallclock secs ( 2.14 usr +  0.00 sys =
  2.14 CPU) @ 466.64/s (n=1000)
      xgen:  1 wallclock secs ( 1.16 usr +  0.01 sys =
  1.17 CPU) @ 853.24/s (n=1000)
        Rate mapgen   xgen
mapgen 467/s     --   -45%
xgen   853/s    83%     --

Happy Benchmarking!

--
hiseldl
"Act better than you feel"

 
#!perl -w

use strict;

# This script is built for the Benchmark module.
use Benchmark qw(cmpthese);

# Import Tk modules
use Tk  800.005;
use Tk::Frame;
use Tk::TextUndo;
use Tk::Text;
use Tk::Entry;
use Tk::Label;
use Tk::Scrollbar;
use Tk::Adjuster;
use Tk::Menu;
use Tk::Menubutton;
use Tk::DialogBox;

# %tk holds refs to all the widgets
use vars qw/%tk/;

# Main Window
$tk{mw} = new MainWindow;
$tk{mw}->geometry('320x320');
Initialize_ui( $tk{mw} );
$tk{count} = 1000;

MainLoop;

sub OnRun
{
    my $supportcode = $tk{code_text}->get(0.1, 'end');
    chomp $supportcode;
    my $test1 = $tk{test1_text}->get(0.1,'end');
    chomp $test1;
    my $test2 = $tk{test2_text}->get(0.1,'end');
    chomp $test2;
    my $testcode    = "{".$test1.",".$test2.",}";
    my $count = $tk{count};

    $tk{output_text}->delete(0.1, 'end');
    my $widget = $tk{output_text}->Subwidget("text");
    tie *STDOUT, ref $widget, $widget;

    print "COUNT=",$count,"\n";
    print "TEST CODE:\n",$testcode,"\n";
    print "SUPPORT CODE:\n",$supportcode,"\n";
    print "RESULTS:\n";
    
    eval (qq($supportcode
         cmpthese($count, $testcode  );
         ));
    print "ERROR: ", $@ if ($@);
}

sub OnClear {
    $tk{count} = 1000;
    $tk{test1_text }->delete(0.1, 'end');
    $tk{test2_text }->delete(0.1, 'end');
    $tk{code_text  }->delete(0.1, 'end');
    $tk{output_text}->delete(0.1, 'end');
}

sub Initialize_ui {
    # $root is a ref to the MainWindow
    my($root) = @_;

    # create widgets
    $tk{toolbar_frame} = $root->Frame ();
    $tk{Clear} = $root->Button (
                  -text => 'Clear',
                  -command => \&OnClear,
                  );
    $tk{Run} = $root->Button (
                  -text => 'Run',
                  -command => \&OnRun,
                  );
    $tk{count_label} = $root->Label (
                     -text => 'count',
                     );
    $tk{count_entry} = $root->Entry (
                     -textvariable => \$tk{count},
                     );
    $tk{test1_label} = $root->Label (
                     -text => 'test1',
                     );
    $tk{test1_text} = $root->Scrolled(
                      'TextUndo',
                      -scrollbars => 'e',
                      -height => '1',
                      -width => '1',
                      );
    $tk{test2_label} = $root->Label (
                     -text => 'test2',
                     );
    $tk{test2_text} = $root->Scrolled(
                      'TextUndo',
                      -scrollbars => 'e',
                      -height => '1',
                      -width => '1',
                      );
    $tk{code_label} = $root->Label (
                    -text => 'code',
                    );
    $tk{code_text} = $root->Scrolled(
                     'TextUndo',
                     -scrollbars => 'e',
                     -height => '1',
                     -width => '1',
                     );
    $tk{adjuster} = $root->Adjuster(
                    -widget => $tk{code_text},
                    -side  => 'top',
                    );
    $tk{output_label} = $root->Label (
                      -text => 'output',
                      );
    $tk{output_text} = $root->Scrolled(
                       'Text',
                       -scrollbars => 'e',
                       -height => '1',
                       -width => '1',
                       );

    # Layout management
    $tk{toolbar_frame}->grid(
                 -in => $root,
                 -column => '2',
                 -row => '1',
                 -sticky => 'nw',
                 );
    $tk{Clear}->grid(
           -in => $tk{toolbar_frame},
           -column => '1',
           -row => '1',
           -sticky => 'nw',
           );
    $tk{Run}->grid(
           -in => $tk{toolbar_frame},
           -column => '2',
           -row => '1',
           -sticky => 'nw',
           );
    $tk{count_label}->grid(
               -in => $root,
               -column => '1',
               -row => '2',
               -sticky => 'nw',
               );
    $tk{count_entry}->grid(
               -in => $root,
               -column => '2',
               -row => '2',
               -sticky => 'nw',
               );
    $tk{test1_label}->grid(
               -in => $root,
               -column => '1',
               -row => '3',
               -sticky => 'nw',
               );
    $tk{test1_text}->grid(
              -in => $root,
              -column => '2',
              -row => '3',
              -sticky => 'nesw',
              );
    $tk{test2_label}->grid(
               -in => $root,
               -column => '1',
               -row => '4',
               -sticky => 'nw',
               );
    $tk{test2_text}->grid(
              -in => $root,
              -column => '2',
              -row => '4',
              -sticky => 'nesw',
              );
    $tk{code_label}->grid(
              -in => $root,
              -column => '1',
              -row => '5',
              -sticky => 'nw',
              );
    $tk{code_text}->grid(
             -in => $root,
             -column => '2',
             -row => '5',
             -sticky => 'nesw',
             );
    $tk{adjuster}->grid(
             -in => $root,
             -column => '2',
             -row => '6',
             -sticky => 'ew',
            );
    $tk{output_label}->grid(
                -in => $root,
                -column => '1',
                -row => '7',
                -sticky => 'nw',
                );
    $tk{output_text}->grid(
               -in => $root,
               -column => '2',
               -row => '7',
               -sticky => 'nesw',
               );

    # Resize behavior management

    # container $root (rows)
    $root->gridRowconfigure(1, -weight  => 0, -minsize  => 9);
    $root->gridRowconfigure(2, -weight  => 0, -minsize  => 9);
    $root->gridRowconfigure(3, -weight  => 0, -minsize  => 30);
    $root->gridRowconfigure(4, -weight  => 0, -minsize  => 30);
    $root->gridRowconfigure(5, -weight  => 1, -minsize  => 45);
    $root->gridRowconfigure(6, -weight  => 0, -minsize  => 20);
    $root->gridRowconfigure(7, -weight  => 1, -minsize  => 60);

    # container $root (columns)
    $root->gridColumnconfigure(1, -weight => 0, 
                               -minsize => 2);
    $root->gridColumnconfigure(2, -weight => 1, 
                               -minsize => 130);

    # container $tk{toolbar_frame} (rows)
    $tk{toolbar_frame}->gridRowconfigure(1, -weight  => 0, 
                                         -minsize  => 24);

    # container $tk{toolbar_frame} (columns)
    $tk{toolbar_frame}->gridColumnconfigure(1, -weight => 0, 
                                            -minsize => 30);
    $tk{toolbar_frame}->gridColumnconfigure(2, -weight => 0, 
                                            -minsize => 30);
}

1;

__END__

Back to Code Catacombs