Algorithm-X-DLX
view release on metacpan or search on metacpan
examples/sudoku/SudokuFormat.pm view on Meta::CPAN
package SudokuFormat;
use strict;
use warnings;
use Carp qw(croak);
use List::Util qw(first);
use Scalar::Util qw(weaken);
sub new {
my ($class, $type_or_format, $input) = @_;
my $self = {};
if ($input && !ref($input)) {
$self->{template} = $input;
}
if (ref($type_or_format) eq 'SudokuType') {
my $type = $type_or_format;
$self->{type} = $type;
$self->{template} ||= default_template($type);
} else {
my $format = $type_or_format;
my $type = SudokuType::guess($format);
$self->{type} = $type;
$self->{template} ||= $format;
}
$self->{labels} = choose_labels($self->{template});
# Validate cells
my $cells = 0;
foreach my $c (split //, $self->{template}) {
if (is_cell($c, $self)) {
$cells++;
}
}
if ($cells != $self->{type}->size()) {
croak "Invalid number of cells";
}
bless $self, $class;
return $self;
}
sub compact {
my ($class, $type) = @_;
my $line = '.' x $type->n() . "\n";
my $result = '';
for (my $y = 0; $y < $type->n(); ++$y) {
$result .= $line;
}
my $self = { type => $type, template => $result, labels => choose_labels($result) };
weaken($self->{type});
return bless $self, $class;
}
sub oneline {
my ($class, $type) = @_;
my $result = '.' x $type->size() . "\n";
my $self = { type => $type, template => $result, labels => choose_labels($result) };
weaken($self->{type});
return bless $self, $class;
}
sub with_labels {
my ($self, $str) = @_;
my @labels = choose_labels_n($str, scalar split //, $self->{type}->n());
my %new_self = %{$self};
@new_self{qw(labels)} = @labels;
return bless \%new_self, ref($self);
}
sub count_cells {
my $str = shift() or return 0;
my $count = 0;
foreach my $c (split //, $str) {
if (is_valid_label($c) || is_empty($c)) {
++$count;
}
}
return $count;
}
sub is_cell {
my ($c, $self) = @_;
return is_empty($c) || index($self->{labels}, $c) != -1;
}
sub value {
my ($c, $self) = @_;
my $pos = index($self->{labels}, $c);
return ($pos == -1) ? 0 : ($pos + 1);
}
sub label {
my ($i, $self) = @_;
croak "Index out of bounds" if ($i > length($self->{labels}));
return ($i == 0) ? '.' : substr($self->{labels}, $i - 1, 1);
}
sub labels {
my ($self) = @_;
return $self->{labels};
}
sub get_values {
my ($str, $self) = @_;
my @labels = choose_labels($str);
my @values;
foreach my $c (split //, $str) {
my $pos = index(join('', @labels), $c);
if ($pos != -1) {
push @values, ($pos + 1);
} elsif (is_empty($c)) {
push @values, 0;
}
}
return \@values;
( run in 0.412 second using v1.01-cache-2.11-cpan-524268b4103 )