File Coverage

lib/Algorithm/MasterMind/EDA_Partitions.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


line stmt bran cond sub pod time code
1             package Algorithm::MasterMind::EDA_Partitions;
2              
3 1     1   754 use warnings;
  1         1  
  1         36  
4 1     1   5 use strict;
  1         2  
  1         62  
5 1     1   5 use Carp;
  1         1  
  1         56  
6              
7 1         4 use lib qw(../../lib
8             ../../../lib
9             ../../../../Algorithm-Evolutionary/lib
10             ../../../Algorithm-Evolutionary/lib
11 1     1   4 ../../Algorithm-Evolutionary/lib);
  1         1  
12              
13             our $VERSION = sprintf "%d.%03d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/g;
14              
15 1     1   312 use base 'Algorithm::MasterMind::EDA';
  1         2  
  1         459  
16              
17             use Algorithm::MasterMind qw(partitions);
18              
19              
20             sub issue_next {
21             my $self = shift;
22             my $rules = $self->number_of_rules();
23             my @alphabet = @{$self->{'_alphabet'}};
24             my $length = $self->{'_length'};
25             my $pop = $self->{'_pop'};
26             my $eda = $self->{'_eda'};
27             map( $_->evaluate( $self->{'_fitness'}), @$pop );
28             my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
29              
30             my %consistent;
31             # print "Consistent in ", scalar keys %{$self->{'_consistent'}}, "\n";
32             if ( $self->{'_consistent'} ) { #Check for consistency
33             %consistent = %{$self->{'_consistent'}};
34             for my $c (keys %consistent ) {
35             my $match = $self->matches( $c );
36             if ( $match->{'matches'} < $rules ) {
37             delete $consistent{$c};
38             }
39             }
40             } else {
41             %consistent = ();
42             }
43             # print "Consistent out ", scalar keys %consistent, "\n";
44            
45             while ( $ranked_pop[0]->{'_matches'} == $rules ) {
46             $consistent{$ranked_pop[0]->{'_str'}} = $ranked_pop[0];
47             shift @ranked_pop;
48             }
49             my $generations_equal = 0;
50             # The 20 was computed in NICSO paper, valid for normal mastermind
51             my $number_of_consistent = keys %consistent;
52            
53             # print "Consistent new ", scalar keys %consistent, "\n";
54             while ( $number_of_consistent < 20 ) {
55             my $this_number_of_consistent = $number_of_consistent;
56             $eda->apply( $pop );
57             for my $p( @$pop ) {
58             my $matches = $self->matches( $p->{'_str'} );
59             # print "* ", $p->{'_str'}, " ", $matches->{'matches'}, "\n";
60             if ( $matches->{'matches'} == $rules ) {
61             # print "Combination ", $p->{'_str'}, " matches ", $p->{'_matches'}, "\n";
62             $consistent{$p->{'_str'}} = $p;
63             }
64             }
65             $number_of_consistent = keys %consistent;
66             if ( $this_number_of_consistent == $number_of_consistent ) {
67             $generations_equal++;
68             } else {
69             $generations_equal = 0;
70             }
71             if ($generations_equal == 15 ) {
72             $eda->reset( $pop );
73             $generations_equal = 0;
74             }
75             # print "G $generations_equal $number_of_consistent \n";
76             last if ( ( $generations_equal >= 3 ) && ( $number_of_consistent >= 1 ) );
77             }
78              
79             # print "After GA combinations ", join( " ", keys %consistent ), "\n";
80             $self->{'_consistent'} = \%consistent;
81             if ( $number_of_consistent > 1 ) {
82             # print "Consistent ", scalar keys %consistent, "\n";
83             #Use whatever we've got to compute number of partitions
84             my $partitions = partitions( keys %consistent );
85            
86             my $max_partitions = 0;
87             my %max_c;
88             for my $c ( keys %$partitions ) {
89             my $this_max = keys %{$partitions->{$c}};
90             $max_c{$c} = $this_max;
91             if ( $this_max > $max_partitions ) {
92             $max_partitions = $this_max;
93             }
94             }
95             # Find all partitions with that max
96             my @max_c = grep( $max_c{$_} == $max_partitions, keys %max_c );
97             # Break ties
98             my $string = $max_c[ rand( @max_c )];
99             # Obtain next
100             return $self->{'_last'} = $string;
101             } else {
102             return $self->{'_last'} = (keys %consistent)[0];
103             }
104            
105             }
106              
107             "Many blacks, 0 white"; # Magic true value required at end of module
108              
109             __END__