Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Re^2: More while issues

by Dandello (Scribe)
on Mar 06, 2011 at 16:26 UTC ( #891690=note: print w/replies, xml ) Need Help??

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

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.

Replies are listed 'Best First'.
Re^3: More while issues
by johngg (Abbot) on Mar 06, 2011 at 16:46 UTC

    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.



      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.

        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.



Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://891690]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (7)
As of 2018-02-19 12:36 GMT
Find Nodes?
    Voting Booth?
    When it is dark outside I am happiest to see ...

    Results (264 votes). Check out past polls.