Alright, this is my first attempt at a genetic algorithm written in Perl. Basically what this does is uses a genetic approach at finding a given string ($thestring).

The program accomplishes this by creating an initial population of strings filled with random characters. It then goes through a series of mutation cycles. Right now the only mutation is the char_replace function, that changes random characters that don't match the target string. I'm in the process of writing other mutation functions, like combining two parent strings to form a child.

The code is pretty rough around the edges and there is still a lot of work to be done. I thought I'd throw it out to the monks for some input. Go easy on me, since this is one of my first Perl programs. =] 

#! /usr/bin/perl
use strict;
use Benchmark;

my ($thestring, $popsize, $str_len, @chr, $i, $str, @init_pop, @init_p
+op_fitness, $max_fit);
# GA To match the string:

$thestring = "the quick brown dog jumped over the lazy fox";

# step one, create an inital population of strings the same size
$popsize = 1000;
$str_len = length($thestring);

# put list of valid characters into @chr
@chr = qw(a b c d e f g h i j k l m n o p q r s t u v w x y z);
@chr = (@chr, " ");

my $best_match = 0;

# fill each string with random character data
for ($i = 0; $i < $popsize; $i++) {
    $str = join '', map $chr[rand @chr], 1..$str_len;
    
    # store the string and it's fitness
    $init_pop[$i][0] = $str;                        
    $init_pop[$i][1] = fitness($str);

    # keep track of the best match for later    
    if ($init_pop[$i][1] > $max_fit) {
        $best_match = $str;
        $max_fit = $init_pop[$i][1];
    }
}

# now, sort the population by fitness (desc) 
@init_pop = sort { $b->[1] <=> $a->[1] } @init_pop;

# STEP 2 - MUTATION
my $keep_percent = .25;               # percent of population to keep
$popsize = $popsize * $keep_percent;

my $num_cycles = $str_len * 4;        # number of mutation cycles to r
+un
my $j;

my $t0 = new Benchmark;
for ($i = 0; $i < $num_cycles; $i++) {

    for ($j = 0; $j < $popsize; $j++) {
        
        $init_pop[$j][0] = char_replace($init_pop[$j][0]);        
        $init_pop[$j][1] = fitness($init_pop[$j][0]);
        
    }

}
my $t1 = new Benchmark;
my $td = timediff($t1, $t0);

@init_pop = sort { $b->[1] <=> $a->[1] } @init_pop;

print("\nCompleted ", $num_cycles, " mutation cycles.\n");
print("Elapsed mutation time: ", timestr($td), "\n");

# count exact matches
my $total_matches = 0;
for ($i = 0; $i < $popsize; $i++) {
    if ($init_pop[$i][1] == $str_len) {
        $total_matches++;
    }
}

print("Total Matches: ", $total_matches, "\n");
# function to calculate the fitness of a given string, 
# that is how many characters match $thestring
sub fitness {
    my $test_str = $_[0];
    my ($j, $fit);
    
    $fit = 0;
        
    for ($j = 0; $j < $str_len; $j++) {
        if (substr($test_str, $j, 1) eq substr($thestring, $j, 1)) {  
+  
            $fit++;
        }
    
    }        
    return $fit;
}
    
# function that replaces a random number of bad characters with new on
+es
sub char_replace {
    my $in = $_[0];
    my $fit = fitness($in);
    my $percent_to_change = rand();
    my $i;
        
    for ($i = 0; $i < $str_len; $i++) {
        if ((rand() < $percent_to_change) && (substr($in, $i, 1) ne su
+bstr($thestring, $i, 1))) {
            substr($in, $i, 1) = join '', map $chr[rand @chr], 1;
        }        
    }
    
    return $in;

}

[download]

In reply to Genetic Algorithms by illsorted

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.