view release on metacpan or  search on metacpan

lib/Algorithm/MasterMind/Canonical_GA.pm  view on Meta::CPAN

package Algorithm::MasterMind::Canonical_GA;

use warnings;
use strict;
use Carp;

use lib qw(../../lib ../../../../Algorithm-Evolutionary/lib/ 
	   ../../../lib
	   ../../Algorithm-Evolutionary/lib/);

our $VERSION =   sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/g; 

use base 'Algorithm::MasterMind::Evolutionary_Base';

use Algorithm::Evolutionary::Op::String_Mutation; 
use Algorithm::Evolutionary::Op::QuadXOver;
use Algorithm::Evolutionary::Op::CanonicalGA;
use Algorithm::Evolutionary::Individual::String;

# ---------------------------------------------------------------------------


sub initialize {
  my $self = shift;
  my $options = shift;
  for my $o ( keys %$options ) {
    $self->{"_$o"} = $options->{$o};
  }

  # Variation operators
  my $m = new Algorithm::Evolutionary::Op::String_Mutation; # Rate = 1
  my $c = Algorithm::Evolutionary::Op::QuadXOver->new( 1,2 ); 

  my $fitness = sub { $self->fitness_orig(@_) };
  my $ga = new Algorithm::Evolutionary::Op::CanonicalGA( $fitness, 
							 $options->{'replacement_rate'},
							 [ $m, $c] );
  $self->{'_fitness'} = $fitness;
  $self->{'_ga'} = $ga;

}


sub issue_next {
  my $self = shift;
  my $rules =  $self->number_of_rules();
  my @alphabet = @{$self->{'_alphabet'}};
  my $length = $self->{'_length'};
  my $pop = $self->{'_pop'};
  my $ga = $self->{'_ga'};
  map( $_->evaluate( $self->{'_fitness'}), @$pop );
  my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;

  if ( $ranked_pop[0]->{'_matches'} == $rules ) { #Already found!
    return  $self->{'_last'} = $ranked_pop[0]->{'_str'};
  } else {
    my @pop_by_matches;
    my $best;
    do {
      $ga->apply( $pop );
      print "Población ", scalar @$pop, "\n";
      map( $_->{'_matches'} = $_->{'_matches'}?$_->{'_matches'}:-1, @$pop ); #To avoid warnings
      @pop_by_matches = sort { $b->{'_matches'} <=> $a->{'_matches'} } @$pop;
      $best = $pop_by_matches[0];
    } while ( $best->{'_matches'} < $rules );
    return  $self->{'_last'} = $best->{'_str'};
  }