in reply to More while issues

How about finding the positions of the 'a' and 'c' characters using a regex look-ahead in a global match along with pos and then randomly replacing 'a's at those positions until there are none left before, if necessary, going on to the 'c's.

use strict;
use warnings;

use feature qw{ say };

my $str;
my $minY;

$str   =  q{accyyaycayaccyyaaycy};
$minY  = 15;

say $str;

my $yCt   = $str =~ tr{y}{};

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

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

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

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

say $str;

[download]

This produces

accyyaycayaccyyaaycy
yycyyyycyyyccyyyyycy

[download]

Running this again but with $minY reduced to 10 gives this

accyyaycayaccyyaaycy
accyyaycyyaccyyyaycy

[download]

I hope this is helpful.

Cheers,

JohnGG

Replies are listed 'Best First'.
Re^2: More while issues
by Dandello (Monk) on Mar 06, 2011 at 16:26 UTC

    While this is probably more efficient - for me it only replaces the last 'a', not a random 'a'. Maybe it has something to do with the 'say' function - which I don't have - but I'm not sure how.

[reply]

      Using print with a newline instead of say, which was introduced in Perl 5.10, should have no effect on the result. Perhaps you could post what you tried as you might have made a slight error when implementing the method.

      Cheers,

      JohnGG

[reply]

        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;
}

        [download]

        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.

[reply]
[d/l]

In Section Seekers of Perl Wisdom