view release on metacpan or  search on metacpan

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

  my $select = new Algorithm::Evolutionary::Op::Tournament_Selection $self->{'_tournament_size'} || 2;
  if (! $self->{'_ga'} ) { # Not given as an option
    $self->{'_ga'} = new Algorithm::Evolutionary::Op::Breeder_Diverser( $operators, $select );    
  }
  $self->{'_replacer'} = new Algorithm::Evolutionary::Op::Replace_Different;

  if (!$self->{'_distance'}) {
    $self->{'_distance'} = 'distance_taxicab';
  }

  $self->{'_max_consistent'} = $max_number_of_consistent;
}

sub compute_fitness {
  my $pop = shift;
  #Compute min
  my $min_distance = 0;
  for my $p ( @$pop ) {
    $min_distance = ( $p->{'_distance'} < $min_distance )?
      $p->{'_distance'}:
	$min_distance;
  }

  for my $p ( @$pop ) {
    $p->Fitness( $p->{'_distance'}+
		 ($p->{'_partitions'}?$p->{'_partitions'}:0)-
		 $min_distance + 1);
  }
}
#----------------------------------------------------------------------------
sub eliminate_last_played {
  my $self = shift;
  my $last_played = $self->{'_last'};

  for my $p ( @{$self->{'_pop'}} ) {
    if ($p->{'_str'} eq $last_played ) {
      $p =  new Algorithm::Evolutionary::Individual::String( $self->{'_alphabet'}, $self->{'_length'} );
    }
  }
}


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

sub issue_next {
  my $self = shift;
  my @rules =  @{$self->{'_rules'}};
  my @alphabet = @{$self->{'_alphabet'}};
  my $length = $self->{'_length'};
  my $pop = $self->{'_pop'};
  my $rules =  $self->number_of_rules();
  my $ga = $self->{'_ga'};
  my $max_number_of_consistent  = $self->{'_max_consistent'};

  my $last_rule = $rules[$#rules];
  my $alphabet_size = @{$self->{'_alphabet'}};

  if ( $self->{'_played_out'} ) {
    $self->eliminate_last_played;
  }
  #Check for combination guessed right except for permutation
  if ($last_rule->{'blacks'}+$last_rule->{'whites'} == $length ) {
    if ( ! $self->{'_consistent_endgame'} ) {
      my %permutations;
      map( $permutations{$_} = 1,
	   map(join("",@$_), 
	       permutations([ split( //, $last_rule->{'combination'} ) ] ) ) );
      my @permutations = keys %permutations;
      $self->{'_endgame'}  = 
	Algorithm::MasterMind::Partition::Most->start_from( { evaluated => $self->{'_evaluated'},
							      alphabet => \@alphabet,
							      rules => $self->{'_rules'},
							      consistent => \@permutations} );
    } else {
      $self->{'_endgame'}  = 
	Algorithm::MasterMind::Partition::Most->start_from( { evaluated => $self->{'_evaluated'},
							      alphabet => \@alphabet,
							      rules => $self->{'_rules'},
							      consistent => $self->{'_consistent_endgame'} } );
    }
    my $string =  $self->{'_endgame'}->issue_next();
    $self->{'_consistent_endgame'} =  $self->{'_endgame'}->{'_consistent'};
    $self->{'_evaluated'} = $self->{'_endgame'}->{'_evaluated'};
    return  $self->{'_last'} = $string;
  } else {
    #Check for no pegs
    if ($last_rule->{'blacks'}+$last_rule->{'whites'} == 0 ) {
      my %these_colors;
      map ( $these_colors{$_} = 1, split( //, $last_rule->{'combination'} ) );
      for (my $i = 0; $i < @{$self->{'_alphabet'}}; $i++ ) {
	if ($these_colors{$self->{'_alphabet'}->[$i]} ) {
	  delete $self->{'_alphabet'}->[$i]  ;
	}
      }
      @{$self->{'_alphabet'}} = grep( $_,  @{$self->{'_alphabet'}} ); # Eliminate nulls
      if ( @{$self->{'_alphabet'}} == 1 ) { # It could happen, and has happened
	  return $self->{'_alphabet'}->[0] x $length;
      }
      if ( @{$self->{'_alphabet'}} < $alphabet_size ) {
	  $self->realphabet;
	  if ( !$self->{'_noshrink'} ) {
	    my $shrinkage =  @{$self->{'_alphabet'}} /$alphabet_size;
	    print "Shrinking to size ", @$pop * $shrinkage
	      ," with alphabet ", join( " ", @{$self->{'_alphabet'}} ), "\n";
	    $self->shrink_to( (scalar @$pop) * $shrinkage );
	  }
	}
      
    }

    #Recalculate distances, new turn
    my (%consistent );
    my $partitions;
    my $distance = $self->{'_distance'};
#    print "Evaluating all \n";
    for my $p ( @$pop ) {
	($p->{'_distance'}, $p->{'_matches'}) = @{$self->$distance( $p->{'_str'} )};
#      ($p->{'_distance'}, $p->{'_matches'}) = @{$self->distance( $p )};
#	print "$p->{'_distance'}, $p->{'_matches'}) =  $p->{'_str'} \n";
	if ($p->{'_matches'} == $rules) {
	  push @{$consistent{$p->{'_str'}}}, $p;