From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

JMERELO / Algorithm-Evolutionary-0.56 / lib / Algorithm / Evolutionary / Op / Permutation.pm 

            

              
1
2
—
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
—
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
—
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
—
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
—
105
106
107
108
109
110
111
112
113
114
115
116
117

              
use strict;
use warnings;
=head1 NAME
  Algorithm::Evolutionary::Op::Permutation - Per-mutation. Got it? 
=head1 SYNOPSIS
  use Algorithm::Evolutionary::Op::Mutation;
  my $xmlStr=<<EOC;
  <op name='Permutation' type='unary' rate='2' />
  EOC
  my $ref = XMLin($xmlStr);
  my $op = Algorithm::Evolutionary::Op::->fromXML( $ref );
  print $op->asXML(), "\n*Arity ->", $op->arity(), "\n";
  my $op = new Algorithm::Evolutionary::Op::Permutation ; #Create from scratch
  my $bitChrom =  new Algorithm::Evolutionary::Individual::BitString 10;
  $op->apply( $bitChrom );
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Class independent permutation operator; any individual that has the
    C<_str> instance variable (like
    L<Algorithm::Evolutionary::Individual::String> and
    L<Algorithm::Evolutionary::Individual::BitString>) of its elements swapped.
=cut
package  Algorithm::Evolutionary::Op::Permutation;
our ($VERSION) = ( '$Revision: 1.1.1.1 $ ' =~ /(\d+\.\d+)/ );
use Carp;
use Algorithm::Evolutionary::Op::Base;
use Algorithm::Permute;
our @ISA = qw (Algorithm::Evolutionary::Op::Base);
#Class-wide constants
our $APPLIESTO =  'Algorithm::Evolutionary::Individual::String';
our $ARITY = 1;
=head1 METHODS
=head2 new
Creates a new permutation operator; see
    L<Algorithm::Evolutionary::Op::Base> for details.
=cut
sub new {
  my $class = shift;
  my $rate = shift || 1;
  my $self = Algorithm::Evolutionary::Op::Base::new( 'Algorithm::Evolutionary::Op::Permutation', $rate );
  return $self;
}
=head2 create
Creates a new mutation operator with an application rate. Rate defaults to 0.5.
Called create to distinguish from the classwide ctor, new. It just
makes simpler to create a Mutation Operator
=cut
sub create {
  my $class = shift;
  my $rate = shift || 1; 
  my $self =  { rate => $rate };
  bless $self, $class;
  return $self;
}
=head2 apply
Applies mutation operator to a "Chromosome" that includes the C<_str>
    instance variable, swapping positions for two of its components.
=cut
sub apply ($;$) {
  my $self = shift;
  my $arg = shift || croak "No victim here!";
  my $victim = $arg->clone();
  croak "Incorrect type ".(ref $victim) if ! $self->check( $victim );
  my @arr = split("",$victim->{_str});
  my $p = new Algorithm::Permute( \@arr );
  $victim->{_str} = join( "",$p->next );
  return $victim;
}
=head1 Copyright
   
  This file is released under the GPL. See the LICENSE file included in this distribution,
  or go to http://www.fsf.org/licenses/gpl.txt
  CVS Info: $Date: 2008/02/12 17:49:39 $ 
  $Header: /cvsroot/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Permutation.pm,v 1.1.1.1 2008/02/12 17:49:39 jmerelo Exp $ 
  $Author: jmerelo $ 
  $Revision: 1.1.1.1 $
  $Name $
=cut