view release on metacpan or  search on metacpan

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

#	print "$p->{'_distance'}, $p->{'_matches'}) =  $p->{'_str'} \n";
	if ($p->{'_matches'} == $rules) {
	  push @{$consistent{$p->{'_str'}}}, $p;
	} else {
	  $p->{'_partitions'} = 0;
	}
    }
    
    my $number_of_consistent = keys %consistent;
    if ( $number_of_consistent > 1 ) {
      $partitions = partitions( keys %consistent );
      # Need this to compute fitness
      for my $c ( keys %$partitions ) {
	for my $p ( @{$consistent{$c}} ) {
	  $p->{'_partitions'} = scalar (keys  %{$partitions->{$c}});
	}
      }
    } elsif ( $number_of_consistent == 1 ) {
      for my $c ( keys %consistent ) {
	for my $p ( @{$consistent{$c}} ) {
	  $p->{'_partitions'} = 1;
	}
      }
    }
    my $generations_equal = 0;
    my $this_number_of_consistent = $number_of_consistent;

    while ( $this_number_of_consistent < $max_number_of_consistent ) {  

      compute_fitness( $pop ); 
      my $new_pop = $ga->apply( $pop, @$pop * $self->{'_replacement_rate'} );  #Apply GA
      for my $p ( @$new_pop ) {
	($p->{'_distance'}, $p->{'_matches'}) = @{$self->$distance( $p->{'_str'} )};
	if ($p->{'_matches'} == $rules) {
	  push @{$consistent{$p->{'_str'}}}, $p;
	} else {
	  $p->{'_partitions'} = 0;
	}
      }
      $pop = $self->{'_replacer'}->apply( $pop, $new_pop );
      $this_number_of_consistent =  keys %consistent;
      if ( $this_number_of_consistent == $number_of_consistent ) {
	$generations_equal++;
      } else {
	$generations_equal = 0;
	$number_of_consistent = $this_number_of_consistent;
	# Compute number of partitions
	if ( $number_of_consistent > 1 ) {
	  $partitions = partitions( keys %consistent );
	} else {
	  $partitions->{(keys %consistent )[0]} = { "allblacks" => 1}; # I know, this is a hack
	}
      }
      for my $c ( keys %consistent ) {
	for my $p ( @{$consistent{$c}}) {
	  $p->{'_partitions'} = scalar (keys  %{$partitions->{$c}});
	}
      }

      if ($generations_equal == MAX_GENERATIONS_RESET ) { #reset pop
	# Print for debugging
	my %population;
	for my $p ( @$pop ) {
	  $population{$p->{'_str'}}++;
	}
	for my $s ( sort { $population{$b} <=> $population{$a} } keys %population ) {
	  print $s, ": ", $population{$s}, " C\n";
	}
	print "Reset\n\n";
	#Do the thing
	$ga->reset( $pop );
	for my $p ( @$pop ) {
	  ($p->{'_distance'}, $p->{'_matches'}) = @{$self->$distance( $p->{'_str'} )};
	}
	$generations_equal = 0;
      }
      last if ( $generations_equal >= MAX_GENERATIONS_EQUAL ) 
	&& ( $this_number_of_consistent >= 1 ) ;
    } # end while
    
    $self->{'_consistent'} = \%consistent; #This mainly for outside info
    if ( $this_number_of_consistent > 1 ) {
	my $max_partitions = 0;
	my %max_c;
	for my $c ( keys %$partitions ) {
	    my $this_max =  keys %{$partitions->{$c}};
	    $max_c{$c} = $this_max;
	    if ( $this_max > $max_partitions ) {
		$max_partitions = $this_max;
	    }
	}
	# Find all partitions with that max
	my @max_c = grep( $max_c{$_} == $max_partitions, keys %max_c );
	# Break ties
	my $string = $max_c[ rand( @max_c )];
	# Obtain next
	return  $self->{'_last'} = $string;
    } else {
	return $self->{'_last'} = (keys %consistent)[0];
    }
  }
}

"some blacks, 1 white"; # Magic true value required at end of module

__END__

=head1 NAME

Algorithm::MasterMind::Evo -  New evolutionary algorithms solving MM - Evo* version


=head1 SYNOPSIS

    use Algorithm::MasterMind::Evo;

  
=head1 DESCRIPTION

This algorithm is a new evolutionary algorithm that includes EndGames
and also using Most Parts score for evolving solutions to