slow code help

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, I'm new to perl and would appreciate any help that you could give me on this bit of redundant code:

 my ($frame,$value);
        foreach (@values)
        {
           my $boo = $hits{$myorgs{$title_order{$count}}};

            if ($boo eq "Self")
            {
               $frame = $tab->Label(-bg => 'black', -relief => 'sunken
+', width => 10);
            }
            else
            {

               if ($boo == 0)
               {
                  $frame = $tab->Label(-bg => 'red', -relief => 'sunke
+n', width => 10);
                  $balloon->attach($frame,-balloonmsg => "E = 0");
               }
               if (1e-99 <= $boo && $boo < 1e-90)
               {
                  $frame = $tab->Label(-bg => 'orange', -relief => 'su
+nken', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-99 < E < 
+1e-90");
               }
               if (1e-90 <= $boo && $boo < 1e-80)
               {
                  $frame = $tab->Label(-bg => 'gold', -relief => 'sunk
+en', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-90 < E < 
+1e-80");
               }
               if (1e-80 <= $boo && $boo < 1e-70)
               {
                  $frame = $tab->Label(-bg => 'yellow', -relief => 'su
+nken', width => 10);
                  $balloon->attach($frame,-balloonmsg <br>=> "1e-80 < 
+E < 1e-70");
               }
               if (1e-70 <= $boo && $boo < 1e-60)
               {
                  $frame = $tab->Label(-bg => 'chartreuse', -relief =>
+ 'sunken', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-70 < E < 
+1e-60");
               }
               if (1e-60 <= $boo && $boo < 1e-50)
               {
                  $frame = $tab->Label(-bg => 'green', -relief => 'sun
+ken', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-60 < E < 
+1e-50");<br>
               }
               if (1e-50 <= $boo && $boo < 1e-40)
               {
                  $frame = $tab->Label(-bg => 'turquoise', -relief => 
+'sunken', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-50 < E < 
+1e-40");
               }
               if (1e-40 <= $boo && $boo < 1e-30)
               {
                  $frame = $tab->Label(-bg => 'navy blue', -relief => 
+'sunken', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-40 < E < 
+1e-30");
               }
               if (1e-30 <= $boo && $boo < 1e-20)
               {
                  $frame = $tab->Label(-bg => 'lavender', -relief => '
+sunken', width => 10);
                  $balloon->attach($frame,-balloonmsg <br>=> "1e-30 < 
+E < 1e-20");
               }
               if (1e-20 <= $boo && $boo < 1e-10)
               {
                  $frame = $tab->Label(-bg => 'purple', -relief => 'su
+nken', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-20 < E < 
+1e-10");
               }
               if (1e-10 <= $boo && $boo < 1)
               {
                  $frame = $tab->Label(-bg => 'grey', -relief => 'sunk
+en', width => 10);
                  $balloon->attach($frame,-balloonmsg => "1e-10 < E < 
+1");
               }
            }
[download]

I was trying to put all of the colors, and all of the value strings in 1 or 2 arrays and add a for loop but couldn't seem to get it to work. Any help from people more experienced than I am would be greatly appreciated.

Thanks,
Mark

Comment on slow code help Download Code

Replies are listed 'Best First'.
Re: slow code help by japhy (Canon) on Aug 08, 2003 at 00:10 UTC
I guess the way I'd do it is with an array that holds the necessary information. I'd loop over it until I found a matching set of low/high values. { # these are only visible to the function my @settings = ( [ (0,0), "red", "E = 0" ], [ (1e-99, 1e-90), "orange", "1e-99 < E < 1e-90" ], ... ); sub color_and_msg { my ($boo, $tab, $balloon) = @_; my ($color, $msg) = ("black", ""); for (@settings) { my ($low, $high, $c, $m) = @$_; if ($low <= $boo and $boo < $high) { ($color, $msg) = ($c, $m); last; } } my $frame = $tab->Label( -bg => $color, -relief => 'sunken', -width => 10, ); $balloon->attach($frame, -balloonmsg => $msg) if $msg; return $frame; # if you need it } } [download] This function would be called like so: `my $frame = color_and_msg($boo, $tab, $balloon);` [download] and it does all the work, in a far more compact fashion. _____________________________________________________ Jeff`[japhy]`Pinyan: Perl, regex, and perl hacker, who'd like a job (NYC-area) `s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;`	[reply] [d/l] [select]
Re: slow code help by revdiablo (Prior) on Aug 08, 2003 at 00:06 UTC
Not sure if this will actually make your code faster, as your node's title seems to imply you want, but here's a much more convenient (imho) way to store all the ranges: #!/usr/bin/perl use strict; use warnings; my @rangecolors = ( { range => [ 1e-99, 1e-90 ], color => 'orange' + }, { range => [ 1e-90, 1e-80 ], color => 'gold' + }, { range => [ 1e-80, 1e-70 ], color => 'yellow' + }, { range => [ 1e-70, 1e-60 ], color => 'chartreuse' + }, { range => [ 1e-60, 1e-50 ], color => 'green' + }, { range => [ 1e-50, 1e-40 ], color => 'turquoise' + }, { range => [ 1e-40, 1e-30 ], color => 'navy blue' + }, { range => [ 1e-30, 1e-20 ], color => 'lavender' + }, { range => [ 1e-20, 1e-10 ], color => 'purple' + }, { range => [ 1e-10, 1 ], color => 'grey' + }, ); foreach (@rangecolors) { print "Between ", $_->{range}[0], " and ", $_->{range}[1], " we want ", $_->{color}, "\n"; } [download] Note, you still need to explicitly check 0.	[reply] [d/l]
Re: slow code help by Zaxo (Archbishop) on Aug 08, 2003 at 01:08 UTC
You can reduce the number of comparisons by recognising that your ranges are a cover of the total range, and disjoint. That lets you check against just one of the bounds of each subrange. For example, in japhy's solution, the loop over @settings can be rewritten, `for (@settings) { if ($boo < $_->[1]) { ($scalar, $msg) = @{$_}[2,3]; last; } }` [download] The savings are not always as great as they appear. A similar effect can be obtained by testing the upper bound first in the redundant form. The short-circuiting `and` operator will take care of the savings. 'Windowing' or 'binning' operations like this can be done with a logarithmic number of comparisons, using a binary tree to store the limits. The added complexity of the code to support that is probably not justified in so small a set of bins as this. After Compline, Zaxo	[reply] [d/l]