Games-Sudoku-General
view release on metacpan or search on metacpan
lib/Games/Sudoku/General.pm view on Meta::CPAN
are interpreted in the Perl sense: undef, 0, and '' are false, and
anything else is true. The parentheses may also contain the words
"read-only" to denote a read-only attribute or "write-only" to denote
a write-only attribute.
In general, the write-only attributes exist as a convenience to the
user, and provide a shorthand way to set a cluster of attributes at
the same time. At the moment all of them are concerned with generating
problem topologies, which are a real pain to specify by hand.
=over
=item allowed_symbols (string)
This attribute names and defines sets of allowed symbols which may
appear in empty cells. The set definitions are whitespace-delimited
and each consists of a string of the form 'name=symbol,symbol...'
where the 'name' is the name of the set, and the symbols are a list
of the symbols valid in a cell to which that set applies.
For example, if you have an odd/even puzzle (i.e. you are given that
at least some of the unoccupied cells are even or odd but not both),
you might want to
$su->set (allowed_symbols => <<eod);
o=1,3,5,7,9
e=2,4,6,8
eod
and then define the problem like this:
$su->problem (<<eod);
1 o e o e e o e 3
o o e o 6 e o o e
e e 3 o o 1 o e e
e 7 o 1 o e e o e
o e 8 e e o 5 o o
o e o o e 3 e 4 o
e o o 8 o o 6 o e
o o o e 1 e e e o
6 e e e o o o o 7
eod
To eliminate an individual allowed symbol set, set it to an empty
string (e.g. $su->set (allowed_symbols => 'o=');). To eliminate all
symbol sets, set the entire attribute to the empty string.
Allowed symbol set names may not conflict with symbol names. If you set
the symbol attribute, all allowed symbol sets are deleted, because
that seemed to be the most expeditious way to enforce this restriction
across a symbol set change.
Because symbol set names must be parsed like symbol names when a
problem is defined, they also affect the need for whitespace on
problem input. See the L<problem()|/problem> documentation for
full details.
=item autocopy (boolean)
If true, this attribute causes the generate() method to implicitly call
copy() to copy the generated problem to the clipboard.
This attribute is false by default.
=item brick (string, write-only)
This "virtual" attribute is a convenience, which causes the object to be
configured with a topology of rows, columns, and rectangles. The value
set must be either a comma-separated list of two numbers (e.g. '3,2')
or a reference to a list containing two numbers (e.g. [3, 2]). Either
way, the numbers represent the horizontal dimension of the rectangle (in
columns) and the vertical dimension of the rectangle (in rows). The
overall size of the puzzle square is the product of these. For example,
$su->set( brick => [ 3, 2 ] )
generates a topology that looks like this
+-------+-------+
| x x x | x x x |
| x x x | x x x |
+-------+-------+
| x x x | x x x |
| x x x | x x x |
+-------+-------+
| x x x | x x x |
| x x x | x x x |
+-------+-------+
Originally there was a third argument giving the total size of the
puzzle. Beginning with version 0.006 this was deprecated, since it
appeared to me to be redundant. As of version 0.021, all uses of this
argument resulted in a warning. As of version 0.022, use of the third
argument will become fatal.
Setting this attribute modifies the following "real" attributes:
columns is set to the size of the big square;
symbols is set to "." and the numbers "1", "2",
and so on, up to the size of the big square;
topology is set to represent the rows, columns,
and small rectangles in the big square, with row
sets named "r0", "r1", and so on, column sets
named "c0", "c1", and so on, and small
rectangle sets named "s0", "s1", and so on for
historical reasons.
=item columns (number)
This attribute defines the number of columns of data to present in a
line of output when formatting the topology attribute, or the solution
to a puzzle.
=item corresponding (number, write-only)
This "virtual" attribute is a convenience, which causes the object
to be configured for "corresponding-cell" Sudoku. The topology is
the same as C<set( sudoku => ... )>, but in addition corresponding
cells in the small squares must have different values. The extra set
names are "u0", "u1", and so on.
lib/Games/Sudoku/General.pm view on Meta::CPAN
sub add_set {
my ($self, $name, @cells) = @_;
$self->{set}{$name} and croak <<eod;
Error - Set '$name' already exists.
eod
foreach my $inx (@cells) {
$self->{cell}[$inx] or croak <<eod
Error - Cell $inx does not exist.
eod
}
foreach my $inx (@cells) {
my $cell = $self->{cell}[$inx];
@{$cell->{membership}} or --$self->{cells_unused};
foreach my $other (@{$cell->{membership}}) {
my $int = join ',', sort $other, $name;
$self->{intersection}{$int} ||= [];
push @{$self->{intersection}{$int}}, $inx;
}
@{$cell->{membership}} = sort $name, @{$cell->{membership}};
}
$self->{set}{$name} = {
name => $name,
membership => [sort @cells],
};
$self->{largest_set} = max ($self->{largest_set},
scalar @{$self->{set}{$name}{membership}});
delete $self->{backtrack_stack}; # Force setting of new problem.
return $self;
}
=head2 constraints_used
%constraints_used = $su->constraints_used;
This method returns a hash containing the constraints used in the most
recent call to solution(), and the number of times each was used. The
constraint codes are the same as for the steps() method. If called in
scalar context it returns a string representing the constraints used
at least once, in canonical order (i.e. in the order documented in the
steps() method).
B<Note:> As of version 0.002, the string returned by the scalar has
spaces delimiting the constraint names. They were not delimited in
version 0.001
=cut
sub constraints_used {
my ( $self ) = @_;
return unless $self->{constraints_used} && defined wantarray;
return %{$self->{constraints_used}} if wantarray;
my $rslt = join ' ', grep {
$self->{constraints_used}{$_}} qw{F N B T X Y W ?};
return $rslt;
}
=head2 copy
$su->copy ()
This method copies the current problem to the clipboard. If solution()
has been called, the current solution goes on the clipboard.
See L<CLIPBOARD SUPPORT|/CLIPBOARD SUPPORT> for what is needed for this
to work.
=cut
{ # Local symbol block.
my $copier;
sub copy {
my ( $self ) = @_;
( $copier ||= eval {
require Clipboard;
Clipboard->import();
sub {
Clipboard->copy( join '', @_ );
return;
};
}
) or croak 'copy() unavailable; can not load Clipboard';
$copier->( $self->_unload() );
return $self;
}
}
=head2 drop_set
$su->drop_set( $name )
This method removes from the current topology the set with the given
name. The set must exist, or an exception is raised.
=cut
sub drop_set {
my ($self, $name) = @_;
$self->{set}{$name} or croak <<eod;
Error - Set '$name' not defined.
eod
foreach my $inx (@{$self->{set}{$name}{membership}}) {
my $cell = $self->{cell}[$inx];
my @mbr;
foreach my $other (@{$cell->{membership}}) {
if ($other ne $name) {
push @mbr, $other;
my $int = join ',', sort $other, $name;
delete $self->{intersection}{$int};
}
}
if (@mbr) {
@{$cell->{membership}} = sort @mbr;
} else {
@{$cell->{membership}} = ();
$self->{cells_unused}++;
}
}
delete $self->{set}{$name};
$self->{largest_set} = 0;
foreach (keys %{$self->{set}}) {
$self->{largest_set} = max ($self->{largest_set},
scalar @{$self->{set}{$_}{membership}});
lib/Games/Sudoku/General.pm view on Meta::CPAN
my @rslt;
wantarray or @args = ($args[0]);
foreach my $name (@args) {
exists $accessor{$name} or croak <<eod;
Error - Attribute $name does not exist, or is write-only.
eod
push @rslt, $accessor{$name}->($self, $name);
}
return wantarray ? @rslt : $rslt[0];
}
sub _get_allowed_symbols {
my ( $self ) = @_;
my $rslt = '';
my $syms = @{$self->{symbol_list}};
foreach (sort keys %{$self->{allowed_symbols}}) {
my @symlst;
for (my $val = 1; $val < $syms; $val++) {
push @symlst, $self->{symbol_list}[$val]
if $self->{allowed_symbols}{$_}[$val];
}
$rslt .= "$_=@{[join ',', @symlst]}\n";
}
return $rslt;
}
sub _get_symbols {
my ( $self ) = @_;
return join ' ', @{$self->{symbol_list}};
}
sub _get_topology {
my ( $self ) = @_;
my $rslt = '';
my $col = $self->{columns};
my $row = $self->{rows} ||= floor (@{$self->{cell}} / $col);
foreach (map {join (',', @{$_->{membership}}) || ','} @{$self->{cell}}) {
$rslt .= $_;
if (--$col > 0) {
$rslt .= ' '
} else {
$rslt .= "\n";
$col = $self->{columns};
if (--$row <= 0) {
$rslt .= "\n";
$row = $self->{rows};
}
}
}
0 while chomp $rslt;
$rslt .= "\n";
return $rslt;
}
sub _get_value {return $_[0]->{$_[1]}}
=head2 paste
$su->paste()
This method pastes a problem from the clipboard.
See L<CLIPBOARD SUPPORT|/CLIPBOARD SUPPORT> for what is needed for this
to work.
=cut
{ # Begin local symbol block
my $paster;
sub paste {
my ( $self ) = @_;
( $paster ||= eval {
require Clipboard;
Clipboard->import();
return sub {
return Clipboard->paste();
};
}
) or croak 'paste() unavailable; can not load Clipboard';
$self->problem( $paster->() );
$self->_unload();
return $self;
}
} # End local symbol block
=head2 problem
$su->problem( $string );
This method specifies the problem to be solved, and sets the object
up to solve the problem.
The problem is specified by a whitespace-delimited list of the symbols
contained by each cell. You can format the puzzle definition into a
square grid (e.g. the SYNOPSIS section), but to the parser a line
break is no different than spaces. If you pass an empty string, an
empty problem will be set up - that is, one in which all cells are
empty.
An exception will be thrown if:
* The puzzle definition uses an unknown symbol;
* The puzzle definition has a different number
of cells from the topology definition;
* There exists a set with more members than the
number of symbols, excluding the "empty"
symbol.
The whitespace delimiter is optional, provided that all symbol names
are exactly one character long, B<and> that you have not defined any
symbol constraint names more than one character long since the last
time you set the symbol names.
=cut
sub problem {
my ( $self, $val ) = @_;
$val ||= '';
( run in 1.182 second using v1.01-cache-2.11-cpan-2398b32b56e )