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 )