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

I'm obviously too close to this and am missing some important memory hogs and bottlenecks.

What this is supposed to do is take the information passed from a form (one button selector and 9 numbers (year interval and population numbers) and to create a data table derived from the numbers given with random variations.

A version of this is at Population Model Form

There are two problems - 1, when the year or population numbers are too large (as in over 20), the whole thing slows to a crawl and times out; and 2, occasionally some of the results are just plain wrong.

I can live with the second issue if the first one is solved.

use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
our $VERSION = 3.11;

my (
    %FORM,      $buffer,    @pairs,     $chntot,    $coper,     $copye
+rr,
    $countgen,  $dlp,       $dp0,       $dp1,       $dr0,       $dr1,
    $dr2,       $dr3,       $dr4,       $dr5,       $drp,       $errch
+k,
    $ercount,   $gener,     $grand,     $grand1,    $grand2,    $grand
+3,
    $grand4,    $incrs,     $incrsdel,  $initial,   $model,     $mpe0,
    $mpe0a,     $mpe1,      $mpe1a,     $mpe1b,     $mpe2,      $mpe2a
+,
    $mpe2b,     $mpe3,      $mpe3a,     $mpe3b,     $mpe4,      $mpe4a
+,
    $mpe4b,     $mpe5,      $mpe5a,     $mpe5b,     $mpy0a,     $mpy1,
    $mpy1a,     $mpy1b,     $mpy2,      $mpy2a,     $mpy2b,     $mpy3,
    $mpy3a,     $mpy3b,     $mpy4,      $mpy4a,     $mpy4b,     $mpy5,
    $mpy5a,     $mpy5b,     $name,      $popbyyer0, $popbyyer1, $popby
+yer2,
    $popbyyer3, $popbyyer4, $popbyyer5, $total,     $total2,    $tot2e
+rror,
    $value,     $x,         $xb,        $y,         $yb,        @aoa,
    @aob,       @aod,       @aox,       @dlarray,
);

use lib '/XXXXXXXX/public_html/cgi-bin/lib',
  'D://websites/savant/cgi-bin/lib';
use CGI::Fast;
use Math::Random::MT::Auto 'rand';
use List::Util qw(shuffle);

use Readonly;
Readonly my $PCNT => 100;
Readonly my $C3   => 3;
Readonly my $C4   => 4;
Readonly my $C5   => 5;

# data from form;
read STDIN, $buffer, $ENV{'CONTENT_LENGTH'};
@pairs = split /&/xsm, $buffer;
foreach my $pair (@pairs) {
    ( $name, $value ) = split /=/xms, $pair;
    $value =~ tr/+/ /;
    $value =~
      s/%([\p{IsAlphabetic}\d][\p{IsAlphabetic}\d])/pack("C", hex($1))
+/egxsm;
    $FORM{$name} = $value;
    $model       = $FORM{'model'};
    $initial     = $FORM{'initial'};
    $copyerr     = $FORM{'copyerr'};
    $mpe0        = $FORM{'mpe0'};
    $mpe1        = $FORM{'mpe1'};
    $mpe2        = $FORM{'mpe2'};
    $mpe3        = $FORM{'mpe3'};
    $mpe4        = $FORM{'mpe4'};
    $mpe5        = $FORM{'mpe5'};
    $mpy1        = $FORM{'mpy1'};
    $mpy2        = $FORM{'mpy2'};
    $mpy3        = $FORM{'mpy3'};
    $mpy4        = $FORM{'mpy4'};
    $mpy5        = $FORM{'mpy5'};
}

datafilla();
popfilea();
#build data table;
    my @tablem    = (
        [ 0,          $mpy1a + 1, $mpy2a + 1, $mpy3a + 1, $mpy4a + 1, 
+],
        [ $mpy1a,     $mpy2a,     $mpy3a,     $mpy4a,     $mpy5a, ],
        [ $mpe0a,     $mpe1a,     $mpe2a,     $mpe3a,     $mpe4a, ],
        [ 0,          $mpy1a,     $mpy2a,     $mpy3a,     $mpy4a, ],
        [ $popbyyer1, $popbyyer2, $popbyyer3, $popbyyer4, $popbyyer5, 
+],
        [ 0,          $grand1,    $grand2,    $grand3,    $grand4, ],
    );
popfileb();


print "Content-type: text/html\n\n" or croak 'cannot print line1';

#html header;
my $head = <<'HEAD';
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
       "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
<head><meta http-equiv='Content-Type' content='text/html; charset=iso-
+8859-1' />
<meta http-equiv='Content-Style-Type' content='text/css' />
<style type='text/css'>
td {padding: .5em; min-width:2.5em; }
</style>
HEAD
print $head or croak 'cannot print head';

#check that 'd' cell ammount matches;
my $errorcheck = $ercount - $grand;
if ( $errorcheck != 0 ) {
    $errchk =
      qq{Oops, you propably want to reload this page - off by $errorch
+eck};
}
else {
    $errchk = 'Okay';
}

#html title, confirm data;
print qq{<title>Model $model</title>\n} or croak 'cannot print title';
print
qq{</head>\n<body>\n<h1>Model $model</h1>\n<p>Initial# $initial<br />C
+opy Error +- $copyerr&#37;</p>\n<p>Year 0 - $mpe0a<br />Year $mpy1 - 
+$mpe1a<br />Year $mpy2a - $mpe2a<br />Year $mpy3a - $mpe3a<br />Year 
+$mpy4a - $mpe4a<br />Year $mpy5a - $mpe5a</p>\n<p>Error check: $errch
+k</p>\n}
  or croak 'cannot print title2';
  
#table width;
$total2 = $total - $tot2error;
my $th = $total2 + 2;

#tabletop header row;
print qq{<table border='1'><tr><th colspan='$th'>Population</th></tr><
+tr>}
  or croak 'cannot print tabletop';

#build first table row;
foreach my $tble ( 0 .. $total2 + 1 ) {
    print qq{<td><b>$tble</b></td>} or croak 'cannot print td2';
}
print q{</tr>} or croak 'cannot print tr';


foreach my $drp ( 0 .. $C4 ) {
    $dp0 = $tablem[0]->[$drp];
    $dp1 = $tablem[1]->[$drp];

    foreach my $y ( $dp0 .. $dp1 ) {
        print qq{<tr><td><b>$y</b></td>} or croak 'cannot print td';
        for my $x ( 0 .. $total2 ) {
            if ( $aod[$x][$y] eq 'd' ) {
                print q{<td style='background-color:#cccccc'>&nbsp;</t
+d>}
                  or croak 'cannot print td';
            }
            elsif ( $aod[$x][$y] eq 'a' ) {
                if ( $model == 1 ) {
                    $coper = popnum1( $x, $y );
                }
                else {
                    $coper = popnum2( $x, $y );
                }
                print qq{<td>$coper</td>} or croak 'cannot print td';
            }

            else {
                print q{<td>&nbsp;</td>} or croak 'cannot print td';
            }
        }
        print q{</tr>} or croak 'cannot print tr';
    }
}
print qq{</table><p>Program Ver: $VERSION</p></body></html>}
  or croak 'cannot print foot';

sub datafilla {
    $mpy0a = 0;
    $mpy1a = $mpy1 || 1;
    $mpy2a = $mpy2 || 1;
    $mpy3a = $mpy3 || 1;
    $mpy4a = $mpy4 || 1;
    $mpy5a = $mpy5 || 1;
    $mpy1b = $mpy1 || 1;
    $mpy2b = $mpy2 - $mpy1 || 1;
    $mpy3b = $mpy3 - $mpy2 || 1;
    $mpy4b = $mpy4 - $mpy3 || 1;
    $mpy5b = $mpy5 - $mpy4 || 1;
    $mpe0a = $mpe0 || 0;
    $mpe1a = $mpe1 || 0;
    $mpe2a = $mpe2 || 0;
    $mpe3a = $mpe3 || 0;
    $mpe4a = $mpe4 || 0;
    $mpe5a = $mpe5 || 0;

    if ( $mpe1a - $mpe0a < 0 ) {
        $mpe1b = abs $mpe1a - $mpe0a;
    }
    else { $mpe1b = 0; }
    if ( $mpe2a - $mpe1a < 0 ) {
        $mpe2b = abs $mpe2a - $mpe1a;
    }
    else { $mpe2b = 0; }
    if ( $mpe3a - $mpe2a < 0 ) {
        $mpe3b = abs $mpe3a - $mpe2a;
    }
    else { $mpe3b = 0; }
    if ( $mpe4a - $mpe3a < 0 ) {
        $mpe4b = abs $mpe4a - $mpe3a;
    }
    else { $mpe4b = 0; }
    if ( $mpe5a - $mpe4a < 0 ) {
        $mpe5b = abs $mpe5a - $mpe4a;
    }
    else { $mpe5b = 0; }

    $grand1 = $mpe1b;
    $grand2 = $mpe1b + $mpe2b;
    $grand3 = $mpe1b + $mpe2b + $mpe3b;
    $grand4 = $mpe1b + $mpe2b + $mpe3b + $mpe4b;
    $grand  = $mpe1b + $mpe2b + $mpe3b + $mpe4b + $mpe5b;

    $popbyyer0 = $mpe0a;
    $popbyyer1 = ( $mpe1a - $mpe0a ) / $mpy1b;
    $popbyyer2 = ( $mpe2a - $mpe1a ) / $mpy2b;
    $popbyyer3 = ( $mpe3a - $mpe2a ) / $mpy3b;
    $popbyyer4 = ( $mpe4a - $mpe3a ) / $mpy4b;
    $popbyyer5 = ( $mpe5a - $mpe4a ) / $mpy5b;

    #max years for table;
    my @years = ( $mpy0a, $mpy1a, $mpy2a, $mpy3a, $mpy4a, $mpy5a );
    my @yearsa = reverse sort { $a <=> $b } @years;
    $gener = $yearsa[0];

    #max population for table;
    my @popul = ( $mpe0a, $mpe1a, $mpe2a, $mpe3a, $mpe4a, $mpe5a );
    my @totpop = reverse sort { $a <=> $b } @popul;
    $total = $totpop[0] + $grand - 1;

    return;
}

#prepopulate copy error array;
sub popfilea {
    foreach my $ya ( 0 .. $gener ) {
        foreach my $xa ( 0 .. $total ) {
            my $copycop  = rand( 2 * $copyerr ) - $copyerr;
            my $copycopa = $copycop / $PCNT;

            $aoa[$xa][$ya] = $copycopa;
        }
    }
    return;
}

#increase - decrease array;
sub popfileb {
    my $countgen0 = 0;

    foreach my $dlp ( 0 .. $C4 ) {
        $dr0 = $tablem[0]->[$dlp];
        $dr1 = $tablem[1]->[$dlp];
        $dr2 = $tablem[2]->[$dlp];
        $dr3 = $tablem[$C3]->[$dlp];
        $dr4 = $tablem[$C4]->[$dlp];
        $dr5 = $tablem[$C5]->[$dlp];

        foreach my $yb ( $dr0 .. $dr1 ) {
            $countgen = $countgen0++ - $dr3;
            my $change = $countgen * $dr4;
            $incrs    = int( $dr2 + $change );
            $incrsdel = int( $dr5 + abs $change );
            $chntot   = $incrsdel + $incrs;

            #pre-populate deletion array;
            my @delarray = ( 0 .. $chntot + 1 );
            @dlarray = shuffle @delarray;

            foreach my $xb ( 0 .. $total ) {

                #set first row;
                if ( $yb == 0 ) {
                    if ( $xb < $dr2 ) {
                        $aod[$xb][0] = 'a';
                    }
                    else {
                        $aod[$xb][0] = 'n';
                    }
                }

                #set increasing rows;
                elsif ( $dr4 >= 0 ) {
                    if ( $xb < $dr5 + $incrs ) {
                        if ( $aod[$xb][ $yb - 1 ] eq 'd' ) {
                            $aod[$xb][$yb] = 'd';
                        }
                        else {
                            $aod[$xb][$yb] = 'a';
                        }
                    }
                    else {
                        $aod[$xb][$yb] = 'n';
                    }
                }

                #set decreasing rows;
                else {
                    if ( $xb <= $chntot ) {
                        if ( $aod[$xb][ $yb - 1 ] eq 'd' ) {
                            $aod[$xb][$yb] = 'd';
                        }
                        elsif ( $aod[$xb][ $yb - 1 ] eq 'a' ) {
                            $aod[$xb][$yb] = 'a';
                        }
                        else {
                            $aod[$xb][$yb] = 'n';
                        }
                    }
                    else {
                        $aod[$xb][$yb] = 'n';
                    }
                }
            }

            #set random decreased cell;
            if ( $dr4 < 0 ) {
                my $cndiea = 0;
                foreach my $del ( 0 .. $chntot ) {
                    if ( $aod[$del][$yb] eq 'd' ) {
                        $cndiea++;
                    }
                }
                my $cnr = $cndiea;
                foreach my $xd ( $cnr .. $incrsdel - 1 ) {
                    my $xda = $dlarray[$xd];
                    if ( $aod[$xda][$yb] eq 'a' ) {
                        $aod[$xda][$yb] = 'd';
                    }
                    elsif ( $aod[ $xda + 1 ][$yb] eq 'a' ) {
                        $aod[ $xda + 1 ][$yb] = 'd';
                    }
                    elsif ( $aod[ $xda + 2 ][$yb] eq 'a' ) {
                        $aod[ $xda + 2 ][$yb] = 'd';
                    }

                }
            }
        }
    }
    my $error = 0;
    foreach my $mycheck ( 0 .. $total ) {
        if ( $aod[$mycheck][$mpy5a] eq 'd' ) {
            $error++;
        }
        $ercount = $error;
    }

    my $toterror = 0;
    foreach my $mycheck2 ( 0 .. $total ) {
        if ( $aod[$mycheck2][$mpy5a] eq 'n' ) {
            $toterror++;
        }
        $tot2error = $toterror;
    }
    return;
}

#model 1;
sub popnum1 {
    ( $x, $y ) = @_;
    foreach my $xa ( 0 .. $total ) {
        for my $ya (0) {
            $aob[$xa][0] = sprintf '%.2f', $initial + $aoa[$xa][0];
        }
        foreach my $ya ( 1 .. $gener ) {
            if ( $aod[$xa][ $ya - 1 ] eq 'n' ) {
                $aob[$xa][$ya] = sprintf '%.2f', $initial + $aoa[$xa][
+0];
            }
            else {
                $aob[$xa][$ya] = sprintf '%.2f',
                  $aoa[$xa][$ya] + $aob[$xa][ $ya - 1 ];
            }
        }
    }

    return $aob[$x][$y];
}

#model 2;
sub popnum2 {
    ( $x, $y ) = @_;
    foreach my $xa ( 0 .. $total ) {
        for my $ya (0) {
            $aob[$xa][0] = sprintf '%.2f', $initial + $aoa[$xa][0];
        }
        foreach my $ya ( 1 .. $gener ) {
            if ( $aod[$xa][ $ya - 1 ] eq 'n' ) {
                my $xx = int rand $xa;
                $aob[$xa][$ya] = sprintf '%.2f',
                  $aoa[$xa][$ya] + $aob[$xx][ $ya - 1 ];
            }
            else {
                $aob[$xa][$ya] = sprintf '%.2f',
                  $aoa[$xa][$ya] + $aob[$xa][ $ya - 1 ];
            }
        }
    }

    return $aob[$x][$y];
}

exit;

[download]

Note, I am using the recommendations from Perl Best Practices. According to that, 'sub datafilla' and 'sub popfileb' are overly complex and sub popfileb is too deeply nested - but I'm having a hard time seeing a way around it.

Thanks

Replies are listed 'Best First'.
Re: This runs WAY too slow
by ELISHEVA (Prior) on Jan 16, 2011 at 09:08 UTC

    Welcome to Perl Monks!

    If I am reading your program right, your program is running on the order of 0(N-squared) where N=$total, i.e. the cumulative grand total of all population years and then some. It definitely isn't going to scale well.

    The culprit I suspect is the way you are calculating your random variations. Each of those calculations runs $total*$gener loops, where $total is the cumulative grand total for all years and then some and $gener is the largest gap in years. You have at least three routines doing this popfilea(), popnum1() and popnum2(). At least one of these mega loops appears to be called for each and every cell of your table. Since one of the table dimensions is derived from the grand total, you are going to end up in O(N^2) land. However, to be sure of the real cause, you should use a profiler, as was suggested above.

    There are some additional minor efficiency issues. As these involve very small numbers of elements, I doubt they are the source of your problems. Still they are habits to watch out for:

    • Statements not directly involved in the loop included in the loop. For example, when you parse the CGI stream, you not only read in the key value pairs, but also reinitialize each and every variable storing form data. Better to initialize the variables after you finish parsing the stream.
    • Finding the maximum with reverse sort. Were $mpe, etc and $mpy, etc in arrays rather than a pile of variables, datafilla() could initialize them with an array. While it was doing that it could look for the maximum value. That way, you could get the maximum value in a single loop without any sorting needed. But even if you stuck with all those variables, reverse sort is a very slow way to get the maximum. It involves a minimum of two loops (one to sort and one to reverse). Much better is to loop through all the values and update an $iMax variable only when you find a bigger number. Long and short you are doing at least 4 loops where you could be doing 1. However, this comment is more for future reference.

    As for reducing the complexity of your functions: move all those $fooN variables into arrays, e.g. @mpe, @mpy, @grand etc. Then you can do a simply loop to set things up instead of all those repetitive almost alike lines.

    Finally, this code was very hard to read largely because it was hard to tell which variables went with which processing steps. The following tips might remedy this:

    • Move all those variables into arrays. This will reduce the number of variables that readers mentally need to keep track of. It also lets you clarify your logic by using loops instead of repetitive code. Repetitive code is easy to write, but very hard to read. The reader can't be sure that all those lines really are variations on the same without studying each and every line carefully. Not fun.
    • Encapsulate the CGI parsing into its own function. Several of your variables are global in scope, but they are only used by the CGI stream parsing phase, e.g. %FORM, @pairs, $buffer, $name, $value are all declared as package globals even though they are never used after the form is read in.
    • And in general try to keep the variables close to where they are used. Even if a variable is global it is still a good idea to pass in any data used by a function as parameters and to return any generated data as return values. That way the code is self-documenting about what inputs and what outputs go with each function. To do this well, you will need to familiarize yourself with array and hash references.

    Something like this:

       # $hFORM is a hash reference

   my $hFORM = parseCGIStream(\*STDIN);

   # input is stored as key-value pairs in $hFORM
   # output is all these variables

   my ($aMpe, $aMpy, $aGrand, $aPopbyyer
      , $total, $gener) = datafilla($hFORM);

   # input is $gener, $total
   # output is $aOa  (array reference storing your @aoa)

   my $aOa = popfilea($gener, $total);

   #... and so on ...

    [download]
[reply]
[d/l]
[select]
Re: This runs WAY too slow
by moritz (Cardinal) on Jan 16, 2011 at 13:02 UTC
    occasionally some of the results are just plain wrong.

    Actually this is your problem No. 1. If the results are sometimes wrong, you can never trust the output. Which means that it doesn't matter how long it takes to get wrong results.

    Note, I am using the recommendations from Perl Best Practices.

    Surely not all of them. For example you declare way too many variables up front. And you're using many variables with similar names that really belong into a compound data structure (array or hash).

    Here's my proposal on how to proceed:

    1. Separate the calculation from any HTML input and CGI output
    2. Write tests for the actual calculations. See Test::Tutorial for a short, gentle introduction
    3. Fix any errors in the calculation
    4. Once you're convinced of the correctness of the calculations, work on the speed. Also feel free to show us the working code and the test suite. I have a few ideas of what might speed up your code, but I wouldn't dare to change anything without a proper test suite.

    One of your structural problems with both popnum1 and popnum2 is that it creates a full 2-dimensional array, and then returns a single element. I guess an effort can be made to short-circuit the calculation with knowledge of $x and $y.

    There might also be a statistical model that can analytically predict some of the results, and thus avoid a whole lot of calculations, but so far I don't have the time to dig deeper into this.

    Perl 6 - second systems done right
[reply]
[d/l]
[select]
      Thank you - mostly I needed some fresh eyes. I did some rearranging - calling popfilla (one of those big arrays) from model1 and model2. Now I see some other places to work on and can set up some better testing.
[reply]
Re: This runs WAY too slow
by roboticus (Chancellor) on Jan 16, 2011 at 06:36 UTC

    Dandello:

    You have too much code for us to look at. That's what profilers are for. See Devel::NYTprof and friends. Once you profile your code, you can then post a reasonably-sized snippet that's running slowly and get advice on it.

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

[reply]
Re: This runs WAY too slow
by poj (Abbot) on Jan 16, 2011 at 20:31 UTC
    Here is an example of how the many variables can be replaced with a few arrays in the datafilla sub 
    sub datafilla {
  for my $y (1..5){
    my $y_diff = ($f_mpy[$y] - $f_mpy[$y-1]) || 1;
    my $e_diff = ($f_mpe[$y] - $f_mpe[$y-1]);
    $popbyyer[$y] = $e_diff / $y_diff;
    $grand[$y] = $grand[$y-1] + ( ($e_diff<0) ? abs ($e_diff) : 0 );
  }
}

    [download]
    and a test page to check it works as expected
    Read more... (3 kB)
    poj
[reply]
[d/l]
[select]
Re: This runs WAY too slow
by JavaFan (Canon) on Jan 17, 2011 at 10:52 UTC
    Before noticing your code is way too long, I spotted: 
    $value =~
      s/%([\p{IsAlphabetic}\d][\p{IsAlphabetic}\d])/pack("C", hex($1))
+/egxsm;

    [download]
    Now, sidestepping the question why you're rolling your own parsing, why match anything alphabetic (more than 100,000 characters will match) or a digit (more than 400 matches). And considering that [\p{IsAlphabetic}\d] is equivalent to \p{Alnum}, you could have saved a lot of typing. Of course, it's still wrong. Much better would be the pattern: %(\p{AHex}{2}), as \p{AHex} matches exactly the 22 characters you want to match. Not a single character more, not a single character less. Much better than the 100,520 characters you're matching.

    And what's up with the modifiers? You have 5, of which you're only using 2. You've no characters in your pattern that will change meaning with the /s, /m and /x modifiers.

[reply]
[d/l]
[select]

      Because that's the recommendation in PBP and that's the line I use in all my forms and that's a line that will disappear once I get the output of 'use CGI' massaged into a form that actually gives good results into my dependent arrays - which is tomorrow's project.

      But 'Alnum' or 'AHex' sounds like a good idea for the short term.

[reply]
        Please read the introduction of PBP again. If you follow recommendations from PBP just because PBP says so, you're doing it wrong.
[reply]
Re: This runs WAY too slow
by Dandello (Monk) on Jan 17, 2011 at 03:40 UTC

    Well, this is the part I know isn't working right

                if ( $dr4 < 0 ) {

                #pre-populate deletion array;
                my @delarray = ( 0 .. $chntot + 1 );
                @dlarray = shuffle @delarray;

                my $cndiea = 0;
                foreach my $del ( 0 .. $chntot ) {
                    if ( $aod[$del][$yb] eq 'd' ) {
                        $cndiea++;
                    }
                }
                my $cnr = 0;
                my $cnx = $cndiea;
                while (  $cnx < $incrsdel ) {
                    foreach my $xd ( 0 .. $chntot) {
                        my $xda = $dlarray[$xd];
                        if ( $aod[$xda][$yb] eq 'a' ) {
                            $aod[$xda][$yb] = 'd';
                            $cnr++;
                        }
                    }
                    $cnx = $cnr;
                }

    [download]

    What this is supposed to do is, on an array with 'a's, 'd's, and 'n's, is count the 'd's, compare that number to what it's supposed to be, then randomly choose an 'a' to turn into a 'd' until the numbers match. Instead, it turns all the 'a's into 'd's. I actually have better luck with :

                
            if ( $dr4 < 0 ) {
                #pre-populate deletion array;
                my @delarray = ( 0 .. $chntot + 1 );
                @dlarray = shuffle @delarray;

                my $cndiea = 0;
                foreach my $del ( 0 .. $chntot ) {
                    if ( $aod[$del][$yb] eq 'd' ) {
                        $cndiea++;
                    }
                }
                my $cnr = $cndiea;
                foreach my $xd ( $cnr .. $incrsdel - 1 ) {
                    my $xda = $dlarray[$xd];
                    if ( $aod[$xda][$yb] eq 'a' ) {
                        $aod[$xda][$yb] = 'd';
                    }
                }
            }

    [download]

    This version only fails about 5% of the time, depending on the ratio of 'd's to 'a's.

    What am I not seeing?

[reply]
[d/l]
[select]

      Ok, so you've isolated a small piece of code that does something bad with some data, great work. But, you haven't given us a framework to test the code nor a failing data set, or even a real indication of what the input data should look like.

      Although laziness is generally to be applauded in the Perl community, it's a form of laziness that requires some work up front. Just a little more work to put that code into a context we can run and a little data will go a long way toward saving us all some time in resolving your problem.

      Note that with simulation bugs where you are using 'random' data it is often useful to seed the random number generator to ensure consistent results for debugging. Even for production code it is a good idea to record the seed that was used for a run so that unexpected results are easier to reproduce.

      True laziness is hard work
[reply]

        Sorry

        Read more... (14 kB)

        A test version is at Model 1

        It's supposed to have only two or three cells grayed out on row 5 and the the other two or three grayed out on 6 (for a total of five) with the grayed out cells extending down to the end of the table. Like this: Model 2 However, Model 2 doesn't use the 'while' statement and occasionally picks out a few too few to gray out.

[reply]
[d/l]
Re: This runs WAY too slow
by Dandello (Monk) on Jan 18, 2011 at 17:53 UTC

    Update

    Many thanks to everybody for their help and comments.

    The code is down to 336 lines and an 800x1600 table outputs not quite as fast as a page here.

    So you can compare to the original file:

    Read more... (12 kB)

    Next step - using CGI.pm to create the form and adding a 'print to file' and 'split file' option. (800 wide is about 3 times what Excel can handle for data crunching.) Any recommendations for a good book on CGI.pm?

    Again, many thanks for the help.

[reply]
[d/l]
      You could save another few lines like this 
      #prepopulate copy error array;
sub popfilea {
  foreach my $ya ( 0 .. $gener ) {
    foreach my $xa ( 0 .. $total ) {
      $aoa[$xa][$ya] = (int rand(1+2*$copyerr)-$copyerr ) /$PCNT;
    }
  }
}

      [download]
      and here 
      sub popnum1 {
  ( $x, $y ) = @_;
  if ( ($y==0) || ($aod[$x][ $y-1 ] ne 'a') ) {
     return $initial + $aoa[$x][0];
  } else {
     return $aoa[$x][$y] + $aob[$x][ $y-1 ];
  }
}

      [download]
      moving the sprintf's to this line 
       
$coper = sprintf '%.2f', popnum1( $x, $y )

      [download]
      or consider combining the two subs into one so that you have 
       
$coper = sprintf '%.2f', popnum( $model, $x, $y )

      [download]
      hth poj
[reply]
[d/l]
[select]

        Shaved off another 15 lines. :)

        Sometimes you're just to close to a project to see the obvious (to everyone else) inefficiencies.

[reply]

Back to Seekers of Perl Wisdom