parent 1: "aaaaaaaaaaaaaa" (these are only copies -- the parents are parent 2: "AAAAAAAAAAAAAA" not modified in this operation) cut here: ^ ^ (these two points chosen at random) and then swap sections.. result 1: "aaaaaaAAAAAAaa" result 2: "AAAAAAaaaaaaAA" #### use strict; use List::Util qw/shuffle sum/; my $str_length = 20; my $pop_size = 50; my @population = sort { fitness($a) <=> fitness($b) } map { rand_string() } 1 .. $pop_size; my $generations; while ( $generations++ < 1000 and fitness($population[-1]) != $str_length ) { my @parents = shuffle @population[-10 .. -1]; my @children; push @children, crossover( splice(@parents, 0, 2) ) while @parents; @population[0 .. 4] = map { mutate($_) } @children; @population = sort { fitness($a) <=> fitness($b) } @population; printf "Average fitness after %d generations is: %g\n", $generations, (sum map { fitness($_) } @population)/@population; } ##### sub fitness { return $_[0] =~ tr/1/1/; } sub crossover { my ($s1, $s2) = @_; my ($start, $end) = sort {$a <=> $b} map { int rand length $s1 } 1 .. 2; (substr($s1, $start, $end - $start), substr($s2, $start, $end - $start)) = (substr($s2, $start, $end - $start), substr($s1, $start, $end - $start)); return ($s1, $s2); } sub mutate { my $s = shift; for (0 .. length($s) - 1) { substr($s, $_, 1) = 1 - substr($s, $_, 1) if rand() < 0.2; } return $s; } sub rand_string { join "" => map { rand() > 0.5 ? 0 : 1 } 1 .. $str_length; }