view release on metacpan or  search on metacpan

examples/sudoku/SudokuFormat.pm  view on Meta::CPAN

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;
}

sub to_string {
    my ($self, @values) = @_;

    my $value_size = scalar(@values);
    my $type_size = $self->type->size();
    croak "to_string(): wrong number of values ($value_size vs. $type_size)" if $value_size != $type_size;
    
    my @result_chars = split //, $self->{template};
    
    my $j = 0;
    for (my $i=0; $i < @result_chars; ++$i) {
        if (is_cell($result_chars[$i], $self)) {
            croak "Logic error" if (@values <= $j);
            $result_chars[$i] = label($values[$j], $self);
            $j++;
        }
    }        

    croak "Logic error" if (@values != $j);
        
    return join('', @result_chars);
}

sub type {
   return shift->{type};
}

sub is_empty {
   my $c = shift;
   return $c eq '.' || $c eq '0';
}

sub is_valid_label {
   return index(valid_labels(), shift) != -1;
}

sub is_valid_cell {
    my $c = shift;
    return is_valid_label($c) || is_empty($c);
}

sub valid_labels {
   return '123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
}

sub choose_labels {
    my ($str) = @_;
    
    my $size = 0;
    foreach my $c (split //, $str) {
        if (is_valid_cell($c)) {
            $size++;
        }
    }
    
    my $n = 0;
    while (($n + 1) * ($n + 1) <= $size) {
        $n++;
    }

    if ($n * $n != $size) {
        croak ":(";
    }
    
    return choose_labels_n($str, $n);
}

sub choose_labels_n {
    my ($str, $n) = @_;
    
    my %used;
    
    foreach my $c (split //, $str) {
        if (is_valid_label($c)) {
            $used{$c}++;
        }
    }

    if (scalar(keys %used) > $n) {