view release on metacpan or  search on metacpan

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

    $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__

=head1 NAME

Algorithm::MasterMind::MOGA - Solver using an Estimation of Distribution Algorithm


=head1 SYNOPSIS

    use Algorithm::MasterMind::MOGA;
    my $secret_code = 'EAFC';
    my $population_size = 200;
    my @alphabet = qw( A B C D E F );
    my $solver = new Algorithm::MasterMind::MOGA { alphabet => \@alphabet,
						length => length( $secret_code ),
						  pop_size => $population_size};
  
    #The rest, same as the other solvers

=head1 DESCRIPTION

Uses L<Algorithm::Evolutionary> instance of MOGAs to solve MM; as there
are two different fitness functions you can use; probably
C<fitness_orig> works better. 

=head1 INTERFACE 

=head2 initialize 

Performs bookkeeping, and assigns flags depending on the
initialization values

=head2 entropy( $combination)

Computes the Jensen-Shannon entropy of the string and returns it.

=head2 fitness_compress( $object ) 

Uses as fitness the entropy of the string attached to all the strings
already played computed above. 

=head2 new ( $options )

This function, and all the rest, are directly inherited from base

=head2 issue_first ()

Issues the first combination, which might be generated in a particular
way 

=head2 issue_next()

Issues the next combination