in reply to Re: More while issues
in thread More while issues

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

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

True laziness is hard work

Replies are listed 'Best First'.
Re^3: More while issues
by Dandello (Monk) on Mar 04, 2011 at 03:59 UTC

    More possible solutions! I need a happy smiley.

      Hi, Using RegExp I'd use the following (here @stash represents the layers):

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