Re^4: More while issues

[Dandello]

sub rankdwn {
    my ( $yb, $chntot, $incrsdel ) = @_;
    my $cnd_a = $aod[$yb] =~ tr/a/a/;
    my $cnd_y = $aod[$yb] =~ tr/y/y/;
    my $str = $aod[$yb];
    my @Posns;

    my $letter = 'a';
    if ( ( $cnd_a + $cnd_y ) <= $incrsdel ) {
        $aod[$yb] =~ s/a/y/gsxm;
        $cnd_y += $cnd_a;
        $letter = 'c';
    }
    while ( $cnd_y < $incrsdel ) {
        push @Posns, pos $str while $str =~ m{(?=a)}g;
        my $offset = splice @Posns, rand @Posns, 1;
        substr $str, $offset, 1, q{y};
        $cnd_y++;
    }
    $aod[$yb] = $str;
    return;
}

For this test I have the $chntot and $incrsdel set so no 'c's will be removed.

This line: caaaaaaayyyyyccyyyyyyyyycyyyyyycycyyyyycyyyyyyyyccyyyyyyyyyycyycyyyyyyyyyyyyyyyyyyyyycyyycyyyyycyyyyyyyyyyyyyyyycyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyxxxxx
should have 15 'c's and 4 'a's.

This line: caaaayyyyyyyyccyyyyyyyyycyyyyyycycyyyyycyyyyyyyyccyyyyyyyyyycyycyyyyyyyyyyyyyyyyyyyyycyyycyyyyycyyyyyyyyyyyyyyyycyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyxxxxx
should have 15 'c's and no 'a's.

But the kicker is several lines above these two: caaaaaaaaaaaaccaaaaaaaaacaaaaaacacaaaaacaaaaaaaaccaaaaaaaaaacaacaaaaaaaaaaaaaaaaaaaaacaaacaaaaacaaaaaaaaaaaaaaaacaaaaaaayyyyyyyyyyyyyyyyyyyyyyyyyyyyyyxxxxx
all the 'y's in a row rather than randomly placed.

[johngg]

Perhaps I was a little optimistic when I said "slight error" :-)

In the code that I posted note how I discover the positions of the 'a' and 'c' letters before I start to modify the string. Note also that I don't have to count how many 'a's there are, only 'y's. This is because, according to your spec, the process of turning letters ('a's first then 'c's) into 'y's only continues until there are enough 'y's so the number of them in the string is the crucial factor. You have rather mangled the logic by forgetting about discovering where the 'a's are and assuming that all them will be changed, and then actually doing so willy nilly in a global substitution. You also move the discovery of letter 'c's inside while loop of the letter 'c' replacement stage when it should actually be done once before the string is modified.

In short, your implementation has almost nothing in common with the code I posted so it is perhaps not surprising that the results differ. A few points about your subroutine:

• I think it would be better to pass and return the actual string being transformed rather than an index into an array, $yb, which you use to read then write to a particular array element.

• You don't seem to use the second parameter, $chntot, at all.

• Your logic breaks if there are more than enough 'a's to change.

• Similarly, what happens if there are not enough 'c's and you exhaust the @Posns array?

• I've already mentioned the problem with moving position finding inside the letter changing loop.

Putting all that together your subroutine might look like this.

...
$aod[$yb] = rankdwn( $aod[$yb], $howManyYsDoWeWant );
...

sub rankdwn {
    my ( $str, $incrsdel ) = @_;

    my $cnd_y = $str =~ tr/y/y/;

    my @aPosns;
    push @aPosns, pos $str while $str =~ m{(?=a)}g;

    my @cPosns;
    push @cPosns, pos $str while $str =~ m{(?=c)}g;

    while ( ( $cnd_y < $incrsdel ) && @aPosns )
    {
        my $offset = splice @aPosns, rand @aPosns, 1;
        substr $str, $offset, 1, q{y};
        $cnd_y ++;
    }

    while ( ( $cnd_y < $incrsdel ) && @cPosns )
    {
        my $offset = splice @cPosns, rand @cPosns, 1;
        substr $str, $offset, 1, q{y};
        $cnd_y ++;
    }

    return $str;
}

I hope this will help you move onward with your code.

[Dandello]

Copying and using the entire subroutine above now gets me a line that should only have 'c's, 'y's and 'x' as:
yayaaaaaaayaaaayyayaaayayaayyyaayyyaaaaayaayayyaacaayaaayaayaayaaayyaayyyyaayayyaayaaayaaaaaayyaaayayaaaayaaaaaaaayyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyxxxxx

It also throws a lot of 'undefined value in $offset' and 'splice offset past end of array' warnings - which is why I had put push @cPosns, pos $str while $str =~ m{(?=c)}g; within a while statement. It doesn't throw warnings and does convert the proper number of 'a's and 'c's into 'y's. But it also doesn't give me my necessary randomness. All the 'y's are 'right' aligned.

As for what happens if there aren't enough 'c's? - That possibility has been caught well before this subroutine.

The $chntot was still listed as I have been a<->b-ing between my older (working) subroutine and this one. The other subroutine calls for $yb, $incrsdel and $chntot.

While the idea of getting the position of the 'a's and 'c's and pulling the random replacements from that looks promising as being more efficient, especially on long strings, the older working subroutine of

sub rankdwn {
    my ( $yb, $incrsdel, $chntot,) = @_;
    my $cnd_a = $aod[$yb] =~ tr/a/a/;
    my $cnd_y = $aod[$yb] =~ tr/y/y/;

    my $letter = 'a';
    if ( ( $cnd_a + $cnd_y ) <= $incrsdel ) {
        $aod[$yb] =~ s/a/y/gsxm;
        $cnd_y += $cnd_a;
        $letter = 'c';
    }
    while ( $cnd_y < $incrsdel ) {
        my $xda = int rand( $chntot + 1 );
        if ( substr( $aod[$yb], $xda, 1 ) eq $letter ) {
            substr $aod[$yb], $xda, 1, 'y';
            $cnd_y++;
        }
    }
    return;
}

works.

I'll keep playing with the pos function idea. I might be able to get it to work - thanks.