File Coverage

lib/Algorithm/MasterMind/EDA.pm

Criterion	Covered	Total	%
statement	15	15	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	20	20	100.0

package Algorithm::MasterMind::EDA;

use warnings;
use strict;
use Carp;

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

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

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

use Algorithm::MasterMind qw(entropy);

use Algorithm::Evolutionary qw( Individual::BitString
				Op::EDA_step );

sub fitness {
    my $self = shift;
    my $object = shift;
    my $combination = $object->{'_str'};
    my $matches = $self->matches( $combination );
    $object->{'_matches'} = $matches->{'matches'};
    my $blacks_and_whites = 1;
    for my $r (@{$matches->{'result'}} ) {
	$blacks_and_whites += $r->{'blacks'} + $r->{'whites'}+ $self->{'_length'}*$r->{'match'};
    }
    return $blacks_and_whites;

}


sub initialize {
  my $self = shift;
  my $options = shift;
  for my $o ( keys %$options ) {
    $self->{"_$o"} = $options->{$o};
  }
  $self->{'_fitness'} = 'orig' if !$self->{'_fitness'};
  $self->{'_first'} = 'orig' if !$self->{'_first'};
  my $length = $options->{'length'};

  #----------------------------------------------------------#
  #                                                          #
  my $fitness;
  if ( $self->{'_fitness'} eq 'orig' ) {
    $fitness = sub { $self->fitness_orig(@_) };
  } elsif ( $self->{'_fitness'} eq 'naive' ) {
    $fitness = sub { $self->fitness(@_) };
  } elsif ( $self->{'_fitness'} eq 'compress' ) {
    $fitness = sub { $self->fitness_compress(@_) };
  }

  #EDA itself
  my $eda = new Algorithm::Evolutionary::Op::EDA_step( $fitness,
						       $options->{'replacement_rate'},
						       $options->{'pop_size'},
						       $self->{'_alphabet'});
  $self->{'_fitness'} = $fitness;
  $self->{'_eda'} = $eda;


}

sub issue_first {
  my $self = shift;
  my ( $i, $string);
  my @alphabet = @{ $self->{'_alphabet'}};
  my $half = @alphabet/2;
  if ( $self->{'_first'} eq 'orig' ) {
    for ( $i = 0; $i < $self->{'_length'}; $i ++ ) {
      $string .= $alphabet[ $i % $half ]; # Recommendation Knuth
    }
  } elsif ( $self->{'_first'} eq 'half' ) {
    for ( $i = 0; $i < $self->{'_length'}; $i ++ ) {
      $string .= $alphabet[ $i /2  ]; # Recommendation first paper
    }
  }
  $self->{'_first'} = 1; # Flag to know when the second is due

  #Initialize population for next step
  my @pop;
  for ( 0..$self->{'_pop_size'} ) {
    my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'},
								 $self->{'_length'} );
    push( @pop, $indi );
  }

  $self->{'_pop'}= \@pop;

  return $self->{'_last'} = $string;
}

sub issue_next {
  my $self = shift;
  my $rules =  $self->number_of_rules();
  my ($match, $best);
  my $pop = $self->{'_pop'};
  my $eda = $self->{'_eda'};

  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 $generations_passed = 0;
    my @pop_by_matches;
    do {
      $eda->apply( $pop );
      map( $_->{'_matches'} = $_->{'_matches'}?$_->{'_matches'}:-1, @$pop ); #To avoid warnings
      @pop_by_matches = sort { $b->{'_matches'} <=> $a->{'_matches'} } @$pop;
      $generations_passed ++;
      $best = $pop_by_matches[0];
      if ($generations_passed == 15 ) {
	$eda->reset( $pop );
	$generations_passed = 0;
      }
    } while ( $best->{'_matches'} < $rules );
    return  $self->{'_last'} = $best->{'_str'};
  }

}

"Many blacks, 0 white"; # Magic true value required at end of module

__END__