Hi

While there are more Perlish ways to do this, such as using tr to count characters, for example, your real problem is with your algorithm.

You don't want to use last to break out of the loop like that, that will break out of the a-replacement loop after replacing just one 'a'. What you want to do is stop the a-replacement loop when there are no 'a's left:

# code not tested because I've not got perl available
# and I renamed your variables
while ( 
       $str =~ tr{a}{} # count the 'a's in $str
       &&        
       $count_y < $min_y # do we still want more 'y's? 
      ) {
  # replace a random 'a' with a 'y'
}
[download]

The code to replace a random 'a' with a 'y' looks like it would work, but it could go on forever randomly choosing elements before it finds an 'a'.

Better to get a list of all the positions with an 'a' and choose randomly between them - and keep track of those that have been replaced already.

I don't see why you need to count the 'y's again after the first while loop. Just increment the counter e.g. $count_y++ when you replace an 'a' with a 'y' in the first while loop.

I don't think you need to count the 'a's again at all: if there still aren't enough 'y's then you must have replaced all 'a's; if there are enough 'y's, you don't care.

You can use exactly the same code to replace 'c's with 'y's as was used to replace 'a's with 'y's. A subroutine would be great here.

Hope this helps.

FalseVinylShrub

To say that you guys are great is understating it SO much.

Between the pointers given above and whatever other suggestions come in, I'm sure I'll have this licked in no time.

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.

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.

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

$string =~ tr/H// returns the number of times the character 'H' occurs in a string.

$string =~ tr/G//d; removes all occurances of the character 'G'.

See tr/SEARCHLIST/REPLACEMENTLIST/cds in perldoc perlop.

Got it

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

    while ( $cnd_y < $incrsdel && $cnd_a > 0 ) {
        my $xda = int rand( $chntot + 1 );
        if ( substr( $aod[$yb], $xda, 1 ) eq 'a' ) {
            substr $aod[$yb], $xda, 1, 'y';
            $cnd_a--;
            $cnd_y++;
        }
    }
    while ( $cnd_y < $incrsdel && $cnd_a == 0 ) {
        my $xda = int rand( $chntot + 1 );
        if ( substr( $aod[$yb], $xda, 1 ) eq 'c' ) {
            substr $aod[$yb], $xda, 1, 'y';
            $cnd_y++;
        }
    }
    return;
}
[download]

Sometimes just having little things pointed out helps. Thanks

That doesn't look very deterministic to me! The following code may work a little more efficiently with large strings:

use strict;
use warnings;

my $incrsdel = 10;
my $str = "acbcybaycayacyccy";
my @chrs = split '', $str;
my $yTot = $str =~ tr/y//;

for my $letter ('a', 'c') {
    $yTot += subLetter ($letter, $incrsdel - $yTot, \@chrs);
    last if $yTot >= $incrsdel;
}

$str = join '', @chrs;
print "$str\n";


sub subLetter {
    my ($letter, $limit, $chrs) = @_;
    my @letPos = grep {$chrs[$_] eq $letter} 0 .. $#$chrs;
    my $count = 0;
    
    while ($count < $limit && @letPos) {
        $chrs->[$letPos[my $idx = rand @letPos]] = 'y';
        splice @letPos, $idx, 1;
        ++$count;
    }
    
    return $count;
}
[download]

Oh, and it scales to a larger set of replaceable characters easily too.

True laziness is hard work

More possible solutions! I need a happy smiley.

You could check first whether there are likely to be enough a's and if not use tr/a/y/ to change them all and then go straight to the c's.

my $letter='a';
if (($cnd_a + $cnd_y) <= $incrsdel){
  $aob[$yb] =~ tr/a/y/;
  $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++;
  }
}
[download]

poj

I apologise if you are using carefully chosen Turkish or Nepalese words for your variable names, but to me they are meaningless gibberish. I think you are trying to compress things too much, I suspect $chntot is a count. You aren't charged by the character, you can be a little more verbose.

They don't need to be very long names, that's for Java. But complete words and well-known contractions are good. The length of a name should be proportional to the scope of it's use. In a small loop you might use i or idx; a long-lived variable might be @playingcard_suits.

Considering the vast majority of my variables look like $dr5[$rn] and $datay{$data[$drp]}, $chntot (change total) is clear as day.

We really need smileys here. - I wonder what chntot means in Nepalese.

This is the latest working version BTW

sub rankdwn {
    my ( $yb, $chntot, $incrsdel ) = @_;
    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;
}
[download]

Posting again (think the last one didn't catch)

use strict;
use warnings;

my $needed_ys = 7;
my $str       = 'Why do you need 7 ys when cll you hve re as and cs';
my $orig      = $str;
my @stash     = qw(a c);

my @existing = $str =~ /y/g;
my $missing = $needed_ys - @existing;

foreach my $letter (@stash) {

    while ( $missing > 0 ) {
       last unless $str =~ s/$letter/y/;
       $missing -= 1;
    }
}

print 'Original: ', $orig, "\n";
print 'Result:   ', $str, "\n";
[download]

Ynon

The algorithm needs randomness in it for the strings that have more than enough 'a's or 'c's.

For example the first row might look like this: aaaaaaaaaaaaaaaaacacaaaaaaaaaaaaaaaaaaaaaaaaaacaaaaaaaaaaaaacaaaaaaaaaaaaacaaaaaaaaaaaacaaaaaaaaaaaaaaaaaaaaaaaaxxxxxxxxxx

The second row might look like this: aaaaaaaaaaaaaaaaacacaaaaaaaaaaaaaaaaaaaaaaaaaacaaaaaaaaaaaaacaaaaaaaaaaaaacaaaaaaaaaaaacaaaaaaaaaaaaaaaaaaaaaaaabxxxxxxxxxxx

The 'a's are 'normal', the 'c' represents 'elite' and the 'b's are newcomers. 'x' is a placeholder. The next script assigns number values to each 'a', 'b', and 'c' based on weighted algorithms. 'b's have their own algorithm and so have no randomness assigned to them. The 'a's and 'c's have their initial positions randomly assigned and then carry down row by row unless total number of 'inheritance lines' needs to decrease - at which time it is replaced by a 'y' (representing a lost line of inheritance AKA a dead person) whose position is also randomly determined.

The randomness is an essential part of the algorithm.