File Coverage

lib/Algorithm/MasterMind/Evolutionary_Base.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Algorithm::MasterMind::Evolutionary_Base;

use warnings;
use strict;
use Carp;

use lib qw(../../lib
	   ../../../lib
	   ../../../../Algorithm-Evolutionary/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';

use Algorithm::MasterMind qw(entropy);

use Algorithm::Evolutionary::Individual::String;

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

sub fitness_compress {
  my $self = shift;
  my $object = shift;
  my $combination = $object->{'_str'};
  my $matches = $self->matches( $combination );
  $object->{'_matches'} = $matches->{'matches'};
  my $fitness = 1;
  my @rules = @{$self->{'_rules'}};
  my $rules_string = $combination;
  for ( my $r = 0; $r <= $#rules; $r++) {
    $rules_string .= $rules[$r]->{'combination'};
    $fitness += abs( $rules[$r]->{'blacks'}
		     - $matches->{'result'}->[$r]->{'blacks'} )
      + abs( $rules[$r]->{'whites'} - $matches->{'result'}->[$r]->{'whites'} );
  }

  return entropy($rules_string)/$fitness;
}

sub fitness_orig {
  my $self = shift;
  my $object = shift;
  my $combination = $object->{'_str'};
  my $matches = $self->matches( $combination );
  $object->{'_matches'} = $matches->{'matches'};

  my $fitness = 1;
  my @rules = @{$self->{'_rules'}};
  for ( my $r = 0; $r <= $#rules; $r++) {
    $fitness += abs( $rules[$r]->{'blacks'} - $matches->{'result'}->[$r]->{'blacks'} ) +
      abs( $rules[$r]->{'whites'} - $matches->{'result'}->[$r]->{'whites'} );
  }
  return 1/$fitness;
}

sub issue_first {
  my $self = shift;
  #Initialize population for next step
  $self->reset();
  $self->{'_first'} = 1; # flag for first
  return $self->{'_last'} = $self->issue_first_Knuth();
}

sub reset {
  my $self=shift;
  my %pop;
  if (  scalar( (@{$self->{'_alphabet'}})** $self->{'_length'} ) < $self->{'_pop_size'} ) {
      croak( "Can't do, population bigger than space" );
  }
  while ( scalar ( keys %pop ) < $self->{'_pop_size'} ) {
      my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'}, $self->{'_length'} );
      $pop{ $indi->{'_str'}} = $indi;
  }
  my @pop = values %pop;
  $self->{'_pop'}= \@pop;
}

sub reset_old {
  my $self=shift;
  my @pop;
  for ( 0.. ($self->{'_pop_size'}-1) ) {
    my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'},
								 $self->{'_length'} );
    push( @pop, $indi );
  }
  $self->{'_pop'}= \@pop;
}

sub realphabet {
    my $self = shift;
    my $alphabet = $self->{'_alphabet'};
    my $pop = $self->{'_pop'};

    my %alphabet_hash;
    map ( $alphabet_hash{$_} = 1, @$alphabet );

    for my $p ( @$pop ) {
	for ( my $i = 0; $i < length( $p->{'_str'} ); $i++ ) {
	    if ( !$alphabet_hash{substr($p->{'_str'},$i,1)} ) {
		substr($p->{'_str'},$i,1, $alphabet->[rand( @$alphabet )]);
	    }
	}
	$p->{'_chars'} = $alphabet;
    }
}

sub shrink_to {
  my $self = shift;
  my $new_size = shift || croak "Need a new size" ;

  do  {
    splice( @{$self->{'_pop'}}, rand( @{$self->{'_pop'}} ), 1 )
  } until (@{$self->{'_pop'}} < $new_size );
}

# sub distance {
#     my $self = shift;
#     my $evo_comb = shift || croak "Need somebody to love\n";

#     my @rules = @{$self->{'_rules'}};
#     my $matches = 0;
#     my $distance = 0;
# #  print "Checking $string, ", $self->{'_evaluated'}, "\n";
#     my $string = $evo_comb->{'_str'};
#     for my $r ( @rules ) {
# 	my $rule_result;
# 	if ( !$evo_comb->{'_results'}->{$r->{'combination'}} ) {
# 	    $rule_result = check_rule( $r, $string );
# 	    $evo_comb->{'_results'}->{$r->{'combination'}} = $rule_result;
# 	} else {
# 	    $rule_result = $evo_comb->{'_results'}->{$r->{'combination'}};
# 	}
# 	$matches++ if ( $rule_result->{'match'} );
# 	$distance -= abs( $r->{'blacks'} - $rule_result->{'blacks'} ) +
# 	    abs( $r->{'whites'} - $rule_result->{'whites'} );
#     }

#     return [$distance, $matches];

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

__END__