ar0n has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

I'm working on a script which has the following function:

sub mutate() {
        my $self = shift;
        # my $strength = shift || 2;
        my($i, $p1, $p2, $c1, $c2);

        my $my_astr = $self->astr();   

        # Get $strength (2) positions and flip the characters
        $c1 = substr($my_astr, $p1 = int rand(length($my_astr)), 1);
        $c2 = substr($my_astr, $p2 = int rand(length($my_astr)), 1);

        substr($my_astr, $p1, 1, $c2);
        substr($my_astr, $p2, 1, $c1);
        
        return $self->astr($my_astr);
}

[download]

As you can see, it flips two characters in a string within its class
Since this is a function which will be called many times,
I was wondering if there isn't a faster way to do this.

Also, how would one go about flipping more than 2 characters
at a time (4, 6, 8, ...)?

Thanks.

Replies are listed 'Best First'.
Re: character flipping
by cwest (Friar) on Jun 09, 2000 at 02:33 UTC
    I think this is what you're looking for... it will allow you to have as many 'flips' as you like, supplied in multiples of two ( that's what you had, I'd probably just say 1 = 1 flip, 2 = 2 flips and so on ). 
    sub mutate {
  my $strength = shift || 2;
     $strength = int( $strength / 2 );
  my $string   = q(Just another Perl Hacker);
  my $array    = [ split //, $string ];
  while ( $strength ) {
    my( $x, $y )     = ( int(rand(@{$array})), int(rand(@{$array})) );
    @{$array}[$x,$y] = @{$array}[$y,$x];
    $strength--;
  }
  my $mutated = join '', @{$array};
  return $mutated;
} # mutate()
print mutate(2),  "\n",
      mutate(4),  "\n",
      mutate(6),  "\n",
      mutate(8),  "\n",
      mutate(30), "\n";

    --
Casey
[reply]
Re: character flipping
by lhoward (Vicar) on Jun 09, 2000 at 01:11 UTC
    I really don't see any big improvements that could be made in that code. I did some benchmarking and I was able to get a small improvement for really large strings (at the expense of a small performance degredation for short strings) by computing the string length only once. i.e. 
    my $len=length($my_astr);
$c1 = substr($my_astr, $p1 = int rand($len), 1);
$c2 = substr($my_astr, $p2 = int rand($len), 1);

    [download]

    I was able to get another small performance boost by doing away with the temp variables $c1 and $c2. However, this code should be viewed with suspicion because it would really misbehave if you were moving more than 1 character blocks and the blocks happened to overlap. 

    $p1 = int rand(length($my_astr));
$p2 = int rand(length($my_astr));
substr($my_astr, $p1, 1, substr($my_astr, $p2, 1));
substr($my_astr, $p2, 1, substr($my_astr, $p1, 1));

    [download]

    When you say "flipping more than 2 characters at a time" do you mean "flipping 2 blocks of more than 1 character each" at a time or "flipping more than 2 blocks of 1 character each"?

    flipping 2 blocks of more than 1 character at a time - would require either a check to prevent the blocks overlapping or special code to handle overlapping blocks properly (depending on how you define properly).

    flipping more than 2 blocks of 1 character each - implementation of this depends on how you define flipping. If you pick A, B, C, and D to flip do you exchange A with B, B with A, C with D and D with A or do you replace A with B, B with C, C with D, and D with A?

[reply]
[d/l]
[select]
Re: character flipping
by eduardo (Curate) on Jun 09, 2000 at 02:35 UTC
    are you doing a genetic algorithm in perl? 'cause if you are take it from someone who has implemented a LOT of GA packages in perl, you WANT to use Bit::Vector... trust me.
[reply]
      grin...

      yep!

      I'm making a little perl script that solves cryptograms. I'm too lazy to it myself, and too curious not to try to find out what the solution is :-)

      The $astr in the mutate() function is an alphabet string. Being thusly every character should be unique. So unless I'm missing something (which happen alot -- believe you me), I don't think I'll be needing Bit::Vector. I will put in /cool_stuff though.

      Thanks!
[reply]

Back to Seekers of Perl Wisdom