Sudoku solver in perl using Moose

Sudoku.pl

package Sudoku::Cell;
use Moose;
use warnings;
use parent 'Clone';
use integer;

has 'possible' =>(
	is  => 'rw',
	isa => 'Int', #an array of booleans
	default=>0b111111111, #9 1s
	trigger=>\&check_possible,
);

sub check_possible{
	my $self = shift;
	my $pos = ${$self}{possible};
	if ($pos > 0b111111111){
		$pos = 0b111111111;
		warn("Invalid possible set");
	}
	${$self}{possible} = ($pos);
}

has 'value' =>(
	is =>'ro',
	isa=>'Int',
	required=>1,
	default=>0,
	writer=>'_set_value',
);

# returns true if the cell was just solved.
sub check_solved{
	 my $self = shift;
	 return 0 if $self->value != 0;
	
	 my $value = 0;
	 my $solved = 1;
	 my $changed = 0;
	 for (0..8) {
		 if ( (($self->possible) >> $_) & 1) {
			 $solved = 0 if $changed;
			 $changed=1;
			 $value = $_ + 1;
		 }
	 }
	 #printf "set value:%d\npos:%b\n", $value, $self->possible;
	 $self->_set_value($value) if $solved & $changed;
	 return $solved & $changed;
 }

sub cross_out {
	my $self = shift;
	my $pos = $self->possible;
	#printf "mask: %b\n", ~(1 << ($_[0]-1));
	$pos = $pos & ~(1 << ($_[0]-1));
	$self->possible($pos);
}


sub get_possible_values{
	my $self = shift;
	my @ret;
	my $pos=$self->possible;
	for (0..8){
		push(@ret, $_+1) if $pos & (1 << ($_));
	}
	return @ret;
}


sub set_value{
	my $self=shift;
	if($_[0] > 9 || $_[0] < 1 ){
		warn "Attempt to set invalid value", $_[0];
		return;
	}
	$self->possible( 1 << ($_[0]-1) );
	$self->_set_value(0);
}

package Sudoku::Board;
use Moose;
use Clone qw(clone);
use integer;
use strict;
use warnings;


has 'card' => (
	is=>'ro',
	isa => 'ArrayRef[ArrayRef[Int]]',
	required=>1,
);

has 'cells' => (
	is=>'rw',
	isa => 'ArrayRef[ArrayRef[Sudoku::Cell]]',
	lazy => 1,
	builder => '_build_cells',
);

# sub clone{
	# my $self = shift;	
	# my $mycells = $self->cells;
	# my $card = $self->card;
	# my $clone = Sudoku::Board->new('card'=>$card);
	# my $cells=$clone->cells;	
	# for my $row (0..8){
		# for my $col (0..8){
			# my $pos = $mycells->[$row][$col]->possible;
			# $cells->[$row][$col]->possible($pos);
		# }
	# }
	# return $clone;
# }

sub row {
	my $self=shift;
	return $self->cells->[$_[0]];
}

sub col{
	my $self=shift;
	my @ret;
	foreach my $i (0..8){
		$ret[$i] = $self->cells->[$i][$_[0]];
	}
	return \@ret;
}

sub box{
	my $self = shift;
	my @ret;
	my $hoff = $_[0] / 3 * 3; #horizontal offset
	my $voff = $_[0] % 3 * 3; #vertical offset
	for my $i (0..8){
		my $row = $i / 3 + $hoff;
		my $col = $i % 3 + $voff;
		$ret[$i] = $self->cells->[$row][$col];
	}
	return \@ret;
}

sub groups{
	my $self = shift;
	my $ret = [];
	for my $i (0..8){
		$ret->[$i] = $self->row($i);
		$ret->[$i+9] = $self->col($i);
		$ret->[$i+18] = $self->box($i);
	}
	#print $ret, "\n";
	return $ret;
}

sub print{
	my $self = shift;
	my $i=1; #counters, space every 3
	my $j=1;
	for (@{$self->cells}){	
		for (@{$_}){
			my $prin = $_->value;
			$prin = '*' unless $_->possible;
			print $prin;
			print ' ' unless $j % 3 ;
			$j++;
		}
		print "\n";
		print "\n" unless $i % 3; 
		$i++;
	}
}

sub print_debug{
	my $self= shift;
	for (@{$self->cells}){
		for my $cel (@{$_}){
			printf "%9b : ", $cel->possible;
			for ($cel->get_possible_values){
				printf "%d,", $_;
			}
			print "\n";
		}
		print "::::\n";
	}
}

sub _build_cells{
	my $self = shift;
	my $cells = [];
	for my $i (0..8){
		for my $j (0..8){
			my $value = $self->card->[$i][$j];
			my $cel = Sudoku::Cell->new();
			$cel->set_value($value) if $value;
			$cells->[$i][$j] = $cel;
			
		} 
	}
	return $cells;
}


sub get_unsolved{
	my $self=shift;
	my @unsolved;
	for (@{$self->cells}){
		for (@{$_}){
			push @unsolved, $_ if $_->value == 0;
		}
	}
	return @unsolved;
}

#check if the board has any dead cells.
#Dead cells can't hold any value.
sub is_unsolveable{
	my $self = shift;
	#take unsolved as a paramater if possible.
	for(@{$self->cells}){
		for( @{$_}){
			return 1 if $_->possible == 0;
		}
	}	
	return 0;
}


#Returns a solved version of the board.
sub solve { #self
	my $self = shift;
	my $ret = $self->clone;
	my $stuck = 0;	
	
	#Figure out spaces by elimination,
	#until we no longer make progress.
	until ($stuck){
		$stuck = 1;
		for my $grp (@{$ret->groups}){
			for my $cel (@{$grp}){
				$stuck = 0 if($cel->check_solved);
				if($cel->value != 0){
					#Eliminate chances from the others.
					for (@{$grp}){
						$_->cross_out($cel->value) unless $_ == $cel; 
					}
				}
			}
		}
	}
		
	#Are we stuck because we are done?
	my @unsolved = $ret->get_unsolved;
	return $ret if $#unsolved == -1;
	
	#Is this a dead end?
	return undef if $ret->is_unsolveable;

	#ok, take a stab in the dark, then try to solve that.
	my $cel = $unsolved[0];
	my @guesses = $cel->get_possible_values;
	for (@guesses){
		$cel->set_value($_);
		my $try = $ret->solve;
		next unless defined $try;
		my @uns = $try->get_unsolved;
		return $try if $#uns == -1;
	}
	
	return $ret;
}

package Sudoku;
no strict 'subs';

my $example1= [ [ 0,8,0, 0,0,0, 2,0,0],
		[ 0,0,0, 0,8,4, 0,9,0],
		[ 0,0,6, 3,2,0, 0,1,0],
		
		[ 0,9,7, 0,0,0, 0,8,0],
		[ 8,0,0, 9,0,3, 0,0,2],
		[ 0,1,0, 0,0,0, 9,5,0],
				
		[ 0,7,0, 0,4,5, 8,0,0],
		[ 0,3,0, 7,1,0, 0,0,0],
		[ 0,0,8, 0,0,0, 0,4,0] ];
		
my $example2= [ [ 0,0,0, 0,2,8, 0,7,0],
		[ 0,0,0, 3,0,0, 0,0,8],
		[ 0,0,8, 0,0,1, 0,0,4],
		
		[ 0,4,0, 0,0,0, 7,0,6],
		[ 0,8,0, 7,5,6, 0,4,0],
		[ 5,0,7, 0,0,0, 0,1,0],
				
		[ 9,0,0, 8,0,0, 6,0,0],
		[ 8,0,0, 0,0,9, 0,0,0],
		[ 0,2,0, 5,4,0, 0,0,0] ];
		
		
my $box_test= [ [ 0,1,2, 1,1,1, 2,2,2],
		[ 3,4,5, 1,1,1, 2,2,2],
		[ 6,7,8, 1,1,1, 2,2,2],
		
		[ 3,3,3, 4,4,4, 5,5,5],
		[ 3,3,3, 4,4,4, 5,5,5],
		[ 3,3,3, 4,4,4, 5,5,5],
				
		[ 6,6,6, 7,7,7, 8,8,8],
		[ 6,6,6, 7,7,7, 8,8,8],
		[ 6,6,6, 7,7,7, 8,8,8] ];

my $sud = Sudoku::Board->new(card=>$example1);
$sud->print;
print "######################\n";
# my $clone = $sud->clone; k
# $clone->print_debug;

my $solution = $sud->solve;
$solution->print;



# Test Cell->cross_out
# for my $i  (1..9){
	# my $cel = Sudoku::Cell->new(value=>0);
	# for (1..9){
		# next if $_ == $i;
		# $cel->cross_out($_);
		# $cel->check_solved;
		# my $pos = $cel->possible;
		# my $value = $cel->value;
		# printf "%d : %bn\n", $value, $pos;
		# for ($cel->get_possible_values){
			# printf "%d,", $_;
		# }
		# print "\n";
	# }
	# $cel->set_value($i);
	# for ($cel->get_possible_values){
		# printf "%d,", $_;
	# }
	# printf ": %d : %bn\n", $cel->value, $cel->possible;
	# printf "solved? %d ; Value? %d\n", $cel->check_solved, $cel->value;
#}

# test Cell->set_value
# and clone
# for my $i  (1..9){
	# my $cel = Sudoku::Cell->new(value=>0);
	# $cel->set_value($i);
	# for ($cel->get_possible_values){
		# printf "%d,", $_;
	# }
	# printf "solved? %d ; Value? %d ; Possible? %b\n", $cel->check_solved, $cel->value, $cel->possible;
	# my $cel = $cel->clone;
	# printf "solved? %d ; Value? %d ; Possible? %b\n", $cel->check_solved, $cel->value, $cel->possible;
# }