Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Hello World GA

by stefan k (Curate)
on Jan 18, 2001 at 20:25 UTC ( #52791=sourcecode: print w/ replies, xml ) Need Help??

Category: Funstuff
Author/Contact Info Stefan Kamphausen <mail@skamphausen.de> http://www.skamphausen.de
Description: I wrote this script together with Laura Stockmann when she did her industrial placement here at Novel Science Int. She was just learning how to code and since we're a company that develops artificial intelligence software we did the famous hello_world using a (simple) genetic algorithm. We only used mutation, no crossover.
#! /usr/bin/perl -w

# Author: Stefan Kamphausen <mail@skamphausen.de>
#         Laura Stockmann <??>

# This programm was written when I taught Laura Stockmann the
# beginnings of programming. For that I used perl (mainly because of
# the possibility to simply start coding this or that without having
# to learn too much for the start). I took us one week from the first
# line of code she'd ever written to this little piece. I have later
# cleaned the code a little and translated variable-names (and the
# like) from german to english.

# I takes a string from the command line (or uses "Hello_World") and
# evolves an individuum from a random population of strings of the
# right size which matches the target. This is when the programm is
# ready and exits. That is: it uses a simple genetic algorithm for the
# development of the optimal solution, which is: print the given
# string. Yes, this is kind of 'academic' *grin*

# Right now the only search operator is mutation and the creation
# of random new individuals. There is no crossover.

####################################################################
##                             LICENSE
####################################################################
# This program is free software; you can redistribute it
# and/or modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.

use Data::Dumper;

# Globals
$popsize = 100;        ## Size of Population
$generation = 0;       ## Generation-Counter
@population = ();      ## All Individuals
%fitness = ();         ## The difference to the target for each indiv

$target = $ARGV[0] || "Hello_World";  ## The Target
$len = length($target);  ## Length of all indivs

$p_mut = 15;          ## probability for the mutation of a single char
                      ## in percent


############ MAIN #########

init_random_pop();
calc_fitness();

while (best_fit() > 0) {
  $generation++;
  sort_population();
  crossover_pop();
  add_new_to_pop();
  mutate_pop();
  calc_fitness();
  print_best();
}

#
######### SUBS ##########

sub init_random_pop {
  for ($p=0;$p<$popsize;$p++) {       ## all parents
    $population[$p] = new_individual();
  }
}

sub print_population {
  foreach (@population) {
    print "$_\n";
  }
}

sub calc_fitness {
  my $p = 0;
  %fitness = ();
  for ($p=0;$p<$popsize;$p++) {
    $fitness{$population[$p]} = calc_diff($target,$population[$p]);
  }
}

sub sort_population {
  @population = sort {$fitness{$a}<=>$fitness{$b}} @population;
}

sub best_fit {
  return $fitness{$population[0]};
}

sub crossover_pop {
  my $sum = 0;
  my $sum2 = 0;
  my ($p,$f);
  
  foreach (keys %fitness) {
    $sum += 1/($fitness{$_}+1);
    $sum2 += $fitness{$_};
  }
  for ($p=0;$p<$popsize/4;$p++) {

    my $p1 = rwheel_parent($sum);
    my $p2 = rwheel_parent($sum);
    my $ch = rwheel_child($sum2);
    
    my $tmp = "";
    for ($f=0;$f<$len;$f++) {
      if (rand()<0.5) {
        $tmp .= substr($population[$p1],$f,1)
      } else {
        $tmp .= substr($population[$p2],$f,1)      
      }
    }
    $population[$ch] = $tmp;
    $fitness{$population[$ch]} = calc_diff($target,$population[$ch]);
  }  
}

sub rwheel_parent {
  # note that the population needs to be sorted!
  my ($sum) = @_;
  my ($p);
  my $rand = rand($sum);
  $sum = 0;
  for ($p=0;$p<$popsize;$p++) {
    $sum += 1/($fitness{$population[$p]}+1);
    if ($sum > $rand) {
      return $p;
    }
  }
  return $popsize-1;
}

sub rwheel_child {
  my ($sum) = @_;
  my $rand = rand($sum);
  my ($p);
  $sum = 0;
  for ($p=$popsize-1;$p>0;$p--) {
    $sum += $fitness{$population[$p]};
    if ($sum > $rand) {
      return $p;
    }
  }
  return $popsize-1;
}

sub add_new_to_pop {
  for ($p=$popsize-5;$p<$popsize-1;$p++) {
    $population[$p] = new_individual();
    # copy best indiv
  }
  $population[$popsize-1]  = $population[0];
}

sub mutate_pop {
  for ($p=1;$p<$popsize;$p++) {
    $tmp = ""; 
    for ($f=0;$f<$len;$f++) {
      if (rand(100) < $p_mut) {
        if (rand(100) < 50) {
          $tmp .= neighbor_char(substr($population[$p],$f,1));
        } else {
          $tmp .= new_char();          
        }
     }
      else {
        $tmp .= substr($population[$p],$f,1);
      }
    }
    $population[$p] = $tmp;
  }
}

sub print_best {
  print "$population[0]  ";
  printf("[%4d] {%5d}\n",$fitness{$population[0]}, $generation);
}

sub new_individual {
  my $tmp = "";
  my $f;
  for ($f=0;$f<$len;$f++) {
    $tmp .= new_char();
  }
  return $tmp;
}
sub new_char {
  while(1) {
    my $B = chr (rand(ord("z")-ord("A")) +ord("A"));
    if (char_is_ok($B)) {
      return ($B);
    }
  }
}

sub neighbor_char {
  my ($c) = @_;
  my $ascii = ord($c);
  #print "Char: $c --> ";
  my $direc = rand()<0.5?-1:1;
  $ascii += $direc;
  
  while(1) {
    if (char_is_ok(chr($ascii))) {
    #  print chr($ascii),"\n";
      return chr($ascii);
    } else {
      $ascii += $direc;
      if ($ascii > 127) {
        $ascii = 0;
      }
    }
  }
}
sub char_is_ok {
  my ($char) = @_;
  if ($char =~/[A-Z]|[a-z]|_/) {
    return 1;
  } else {
    return 0;
  }
}

sub calc_diff {
  my ($S1,$S2) = @_ ;
  my $summe=0;
  my $f;
  for($f=0;$f<$len;$f++) { 
    my $Z1=substr($S1,$f,1);
    my $Z2=substr($S2,$f,1);
    
    my $A=(ord($Z1)-ord($Z2))*(ord($Z1)-ord($Z2));
    $summe +=$A;
  }   
  return $summe;
}

Comment on Hello World GA
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://52791]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2015-07-30 00:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (269 votes), past polls