Well, sort of

I'm trying to speed up a subroutine by going from this

sub popnum3 {
    my ( $x, $y, $z, $zazb ) = @_;
    if ( $y == 0 ) {
        $aob[$x][0] = $initial * ( 1 + $z );
    }
    else {
        while (1) {
            my $xda = int rand( $total + 1 );
            
            if ( substr( $zazb, $xda, 1 ) eq 'c' ) {
                $aob[$x][$y] = $aob[$xda][ $y - 1 ] * ( 1 + $z );
                last;
            }
        }
    }
    return $aob[$x][$y];
}
[download]

Which gets - for obvious reasons - REALLY slow on large strings, to something like this:

sub popnum3 {
    my ( $x, $y, $z, $zazb ) = @_;
    if ( $y == 0 ) {
        $aob[$x][0] = $initial * ( 1 + $z );
    }
    else {
        while (1) {
            my @cPosns;
            push @cPosns, pos $zazb while $zazb =~ m{(?=c)}g;
            my $offset = splice @cPosns, rand @cPosns, 1;
            $aob[$x][$y] = $aob[$offset][ $y - 1 ] * ( 1 + $z );
            last;
        }
    }
    return $aob[$x][$y];
}
[download]

Which I just can't seem to get my head around to get it to work without throwing 'undefined value' warnings all over the place.

For both these, $x and $y are 2d array references, $z is a predetermined random number and $zazb is a string containing a more or less random number of 'a's, 'c's, 'y's and 'x's (and may be over than 25,000 characters long). This subroutine is supposed to locate one of the 'c's in $zazb, (without iterating over the entire string repeatedly) grab its mate from the @aob array (which is a number) and determine the value of $aob[$x][$y] based on the value of 'c's mate.

This code

my @cPosns;
push @cPosns, pos $zazb while $zazb =~ m{(?=c)}g;
my $offset = splice @cPosns, rand @cPosns, 1;
[download]

is adapted from http://www.perlmonks.org/?node_id=891330

Update

Despite ikegami's input, I still can't get anything even closely related to the above code to work for this instance. However, since the parameters of the model data has changed, it's no longer an issue as all the indexes for 'c' need to saved to a file for data-munging.

So, this does a good and fast job finding the indices for 'c' from @aod (the array of strings containing 'c'.)

tie my @aod, 'Tie::File', 'bias/array.txt', recsep => "\n";

my $letter = 'c';
my $result = 0;
open my $DATABASE, '>', $datafileout or croak 'dataout not made.';
foreach my $r (0 .. $gener){
    $result = index($aod[$r], $letter);
    while ($result != -1){
       print {$DATABASE} qq{$result,};
       my $offset = $result + 1;
       $result = index($aod[$r], $letter, $offset);
     }
     print {$DATABASE} qq{\n} or croak 'unable to print';
}   

close $DATABASE or croak 'data1 not closed.';
[download]

then for the random indexes ($off is the array of 'c' indices.)

my @offst = split /\,/xsm, $off[$y - 1];
[download]

then to get the random offset

 my $index  = int rand ($#offst);
 $offset = $offst[$index];
[download]

It may not be pretty - but it does work.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.