in reply to This runs WAY too slow

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?

Replies are listed 'Best First'.
Re^2: This runs WAY too slow
by GrandFather (Saint) on Jan 17, 2011 at 05:00 UTC

    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]

        Of course, after posting this, I think I figured it out.

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

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

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom