#! /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;
}
[download]