File Coverage

blib/lib/Games/Sudoku/OO/Set.pm
Criterion Covered Total %
statement 109 112 97.3
branch 31 32 96.8
condition 18 21 85.7
subroutine 9 9 100.0
pod 0 8 0.0
total 167 182 91.7


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl -w
2              
3             package Games::Sudoku::OO::Set;
4              
5 2     2   10 use strict;
  2         4  
  2         2656  
6              
7             sub new {
8 291     291 0 384 my $proto = shift;
9 291   33     914 my $class = ref($proto) || $proto;
10 291         911 my %args = (cells=>undef, possibles=>undef, @_);
11 291         499 my $self = {};
12 291 100       699 if (defined $args{possibles}){
13 194         247 %{$self->{POSSIBLES}} = %{$args{possibles}};
  194         1243  
  194         824  
14 194         541 %{$self->{UNSOLVED_VALUES}} = %{$args{possibles}};
  194         1322  
  194         642  
15             }else {
16 97         263 $self->{POSSIBLES} = {};
17 97         197 $self->{UNSOLVED_VALUES} = {};
18             }
19            
20 291         478 @{$self->{QUEUED_SOLVED_CELLS}}= ();
  291         725  
21 291         530 $self->{SOLVED_CELLS} = {};
22 291         496 $self->{UNSOLVED_CELLS} = {};
23            
24 291         565 foreach my $cell (@{$args{cells}}){
  291         851  
25 0         0 $self->addCell($cell);
26             }
27 291         946 bless ($self, $class);
28 291         1036 return $self;
29             }
30              
31             sub addCell {
32 2955     2955 0 4072 my $self = shift;
33 2955         5094 my $cell = shift;
34 2955         13080 $self->setBackReference($cell);
35 2955         3695 push @{$self->{CELLS}}, $cell;
  2955         7147  
36 2955 50       9998 if (defined $cell->getValue()){
37 0         0 $self->{SOLVED_CELLS}{$cell} = $cell;
38 0         0 delete $self->{UNSOLVED_VALUES}{$cell->getValue()};
39             }else {
40 2955         14484 $self->{UNSOLVED_CELLS}{$cell} = $cell;
41             }
42             }
43              
44             sub solve {
45 1695     1695 0 2681 my $self = shift;
46 1695         3699 $self->propagateSolved();
47 1695         4775 $self->findHasToBeCells();
48 1695         4825 return keys %{$self->{UNSOLVED_CELLS}};
  1695         6852  
49             }
50              
51             sub notifySolved{
52 2955     2955 0 4116 my $self = shift;
53 2955         4130 my $cell = shift;
54             #print STDERR "notified that ". $cell->toStr ." was solved\n";
55 2955         11892 $self->{SOLVED_CELLS}{$cell} = 1;
56 2955         7985 delete $self->{UNSOLVED_CELLS}{$cell};
57 2955         11471 delete $self->{UNSOLVED_VALUES}{$cell->getValue()};
58 2955         4285 push @{$self->{QUEUED_SOLVED_CELLS}}, $cell;
  2955         11304  
59             }
60              
61             sub propagateSolved {
62 1695     1695 0 2387 my $self = shift;
63 1695         2014 my @queue = @{$self->{QUEUED_SOLVED_CELLS}};
  1695         5407  
64 1695 100       5305 return unless (@queue);
65            
66 1088         1518 @{$self->{QUEUED_SOLVED_CELLS}} = ();
  1088         2842  
67            
68 1088         2246 foreach my $solved_cell (@queue){
69             #print "propagating :" . $solved_cell->toStr ."\n";
70 2951         3648 while( my (undef, $test_cell) = each (%{$self->{UNSOLVED_CELLS}})){
  12587         48839  
71 9636         35021 $test_cell->notPossible($solved_cell->getValue());
72             }
73             }
74              
75 1088         2974 $self->checkConsistency();
76             }
77              
78             sub findHasToBeCells {
79 1695     1695 0 2616 my $self = shift;
80 1695         2475 my @unsolved_values = keys (%{$self->{UNSOLVED_VALUES}});
  1695         19491  
81 1695         4082 foreach my $value (@unsolved_values){
82 3091         4863 my @couldBe = ();
83 3091         4132 foreach my $cell (values %{$self->{UNSOLVED_CELLS}}){
  3091         10736  
84 17052 100       51186 if ($cell->couldBe($value)){
85 10716         23071 push @couldBe, $cell;
86             }
87             }
88 3091 100       11642 if (@couldBe == 1){
    100          
89             #print $couldBe[0]->toStr(). " has to be $value\n";
90 212         792 $couldBe[0]->setValue($value);
91             }elsif(@couldBe){
92 2686         3496 my $saved_row;
93 2686         3743 my $rows_equal=1;
94 2686         6689 my $saved_column ;
95 2686         3414 my $columns_equal=1;
96 2686         2814 my $saved_square;
97 2686         3465 my $squares_equal = 1;
98 2686         4122 foreach my $cell (@couldBe){
99             #print $cell->toStr . "could be $value\n";
100            
101 10504         35387 my $row = $cell->getRow();
102 10504 100 100     65984 if (defined $saved_row && ($saved_row != $row)){
103             # print $cell->toStr() . "not in the same row\n";
104 1896         2727 $rows_equal = 0;
105             }
106 10504         14054 $saved_row = $row;
107            
108 10504         27737 my $column = $cell->getColumn();
109 10504 100 100     58597 if (defined $saved_column && ($saved_column != $column)){
110             # print $cell->toStr() . "not in the same column\n";
111 6968         10082 $columns_equal = 0;
112             }
113 10504         13600 $saved_column = $column;
114              
115 10504         36281 my $square = $cell->getSquare();
116 10504 100 100     54660 if (defined $saved_square && ($saved_square != $square)){
117             #print $cell->toStr() . "not in the same square\n";
118 3805         5198 $squares_equal = 0;
119             }
120 10504         22516 $saved_square = $square;
121             }
122 2686 100 100     10439 if ($squares_equal && $saved_square != $self){
123             #print "rest of square can't be $value\n";
124 244         611 $saved_square->setCantBeCells($value,@couldBe);
125             }
126 2686 100 66     7267 if ($columns_equal && $saved_column != $self){
127             #print "rest of column can't be $value\n";
128 308         785 $saved_column->setCantBeCells($value,@couldBe);
129             }
130 2686 100 100     21605 if ($rows_equal && $saved_row != $self){
131             #print "rest of row can't be $value\n";
132 219         559 $saved_row->setCantBeCells($value,@couldBe);
133             }
134             }
135             }
136             }
137              
138             sub setCantBeCells {
139 771     771 0 1059 my $self = shift;
140 771         1054 my $value = shift;
141 771         1542 my @has_to_be = @_;
142 771         906 foreach my $cell (values %{$self->{UNSOLVED_CELLS}}){
  771         5336  
143 3837         7509 my $duplicate = 0;
144             #print "checking if " . $cell->toStr() . "is a has to be\n";
145 3837         6284 foreach my $has_to_be (@has_to_be){
146 8502 100       22416 if ($cell == $has_to_be){
147 1673         3345 $duplicate++;
148             }
149             }
150 3837 100       11067 unless ($duplicate){
151             #print $cell->toStr . "can't be $value\n";
152 2164         7201 $cell->notPossible($value);
153             }
154             }
155             }
156              
157             sub checkConsistency {
158 1088     1088 0 1636 my $self = shift;
159 1088         1307 my %seen_values;
160 1088         1249 foreach my $cell (@{$self->{CELLS}}){
  1088         6256  
161 11850 100       30097 if(defined $cell->getValue()){
162 8581 100       26938 if($seen_values{$cell->getValue()}){
163 219         583 print "INCONSISTENT!!!". $cell->toStr(). "\n";
164             }
165            
166 8581         32692 $seen_values{$cell->getValue()}++;
167             }
168             }
169            
170             }
171              
172             1;