I’ve been doing the Perl Weekly
Challenges. The
latest
involved list searches and combinatorial explosions. (Note that this
is open until 15 November 2020.)
Task #1 › Pair Difference
You are given an array of integers @N
and an integer $A
.
Write a script to find find if there exists a pair of elements in
the array whose difference is $A
.
Print 1
if exists otherwise 0
.
This looks to me like a "see whether this element exists" problem, and
for those I reach for my hashes.
sub pd {
my $n=shift;
my $a=shift;
Make the %n
hash of all the input values.
my %n=map {$_ => 1} @{$n};
Then for each candidate value ($a
plus each value in %n
) see
whether it exists.
foreach my $p (map {$_+$a} keys %n) {
if (exists $n{$p}) {
return 1;
}
}
return 0;
}
Raku works similarly, but has the Set type.
sub pd(@n,$a) {
my $n=Set.new(@n);
for map {$_+$a},$n.keys -> $p {
if ($n{$p}:exists) {
return 1;
}
}
return 0;
}
So does Python. (I don't like that reuse of in
for two moderately
different things.)
def pti(n,a):
ns=set(n)
for x in n:
if x+a in ns:
return 1
return 0
And Ruby, with an external though standard library for sets.
def pti(n,a)
ns=Set.new(n)
n.each do |x|
if ns.include?(x+a)
return 1
end
end
return 0
end
And because these have been being quite easy, I thought I'd try it in
Rust too. There's probably a neater way of using an iterator to
populate the HashMap all in one go, but I'm still very much finding my
way in Rust.
use std::collections::HashMap;
fn pti(n: Vec<i32>, a: i32) -> i8 {
let mut tab=HashMap::new();
for x in n.clone() {
tab.insert(x,1);
}
for x in n {
if tab.contains_key(&(x+a)) {
return 1;
}
}
return 0;
}
Task #2 › Sudoku Puzzle
You are given Sudoku puzzle (9x9).
Write a script to complete the puzzle (etc.)
To do this properly is quite hard work. However, the example puzzle
can be solved with simple elimination (find a cell that has only one
possible value, set it to that value, and repeat). I went one step
further, but explicitly not to the point of an exhaustive
backtracking search – this is not a general Sudoku solver, though
it'll do many simple examples. I also did this one only in Perl.
my @symbols=('1'..'9');
my $order=3;
my $sqo=$order*$order;
my $sqo1=$sqo-1;
my @p;
my $ss=join('',@symbols);
my @r;
@p
gets the puzzle loaded into it. @r
, with corresponding indices,
contains candidate values as a hash. (Which starts at all of 1-9 for
blank cells.)
open I,'<',($ARGV[0] || 'puzzle');
while (<I>) {
chomp;
s/[ \[\]]+//g;
push @p,[map {if (/[$ss]/) {$_} else {''} } split '',$_];
my @ra;
foreach (0..$#{$p[-1]}) {
if ($p[-1][$_] eq '') {
push @ra,{map {$_ => 1} @symbols};
} else {
push @ra,{$p[-1][$_] => 1};
}
}
push @r,\@ra;
}
Build the coordinate sets (csets). Each cset is a list of coordinates
defining a group with exclusive values: so in this order-(3,3) puzzle
there are nine csets corresponding to the rows, nine to the columns,
and nine to the 3×3 boxes. (This way I can apply any algorithm cleanly
to each cset, rather than having three separate calls from different
loops.)
my @cset;
foreach my $ri (0..$sqo1) {
push @cset,[map {[$ri,$_]} (0..$sqo1)];
}
foreach my $ci (0..$sqo1) {
push @cset,[map {[$_,$ci]} (0..$sqo1)];
}
for (my $rb=0;$rb<$sqo1;$rb+=$order) {
for (my $cb=0;$cb<$sqo1;$cb+=$order) {
my @c;
foreach my $ri ($rb..$rb+$order-1) {
foreach my $ci ($cb..$cb+$order-1) {
push @c,[$ri,$ci];
}
}
push @cset,\@c;
}
}
while (!solved(\@p)) {
my $dirty=0;
While the puzzle is unsolved, do single eliminations.
foreach my $c (@cset) {
$dirty+=eliminate_1(\@p,\@r,$c);
}
If that didn't produce any change, try open tuples.
unless ($dirty) {
foreach my $c (@cset) {
$dirty+=eliminate_open_tuple(\@p,\@r,$c);
}
}
More techniques would be added here. In the real world I'd use
Games::Sudoku::General
which is already in CPAN (and which I already use to generate
order-(4,4) sudoku puzzles for a friend who got to enjoy them when
they were trendy and likes to keep doing them now that they aren't),
but that would seem to be missing the point of this exercise.
If we tried everything without getting any changes, give up.
Otherwise, loop back to see if one of the changes has made the puzzle
susceptible to a simpler technique.
unless ($dirty) {
warn "I give up\n";
last;
}
}
Print the final grid.
foreach my $r (@p) {
print join(' ',map {$_ eq ''?'_':$_} @{$r}),"\n";
}
Test for the grid being solved: are there any blanks in it?
sub solved {
my @p=@{$_[0]};
foreach my $r (@p) {
foreach my $c (@{$r}) {
if ($c eq '') {
return 0;
}
}
}
return 1;
}
Single elimination. Within a given cset, remove each known cell value
from the list of possible values for other cells. If this leaves a
cell with only one possible value, set it.
sub eliminate_1 {
my $p=shift;
my $r=shift;
my $c=shift;
my %rm;
my $dirty=0;
foreach my $cp (@{$c}) {
if ($p->[$cp->[0]][$cp->[1]] ne '') {
$rm{$p->[$cp->[0]][$cp->[1]]}=1;
}
}
if (%rm) {
foreach my $cp (@{$c}) {
if ($p->[$cp->[0]][$cp->[1]] eq '') {
map {delete $r->[$cp->[0]][$cp->[1]]{$_}} keys %rm;
if (scalar keys %{$r->[$cp->[0]][$cp->[1]]}==1) {
$p->[$cp->[0]][$cp->[1]]=(keys %{$r->[$cp->[0]][$cp->[1]]})[0];
$dirty=1;
}
}
}
}
return $dirty;
}
Open tuples. If there are (say) two cells in the cset with possible
values "2, 4", then one of them is definitely 2 and the other is
definitely 4; so we can eliminate 2 and 4 from all other cells in the
cset. Again, if this leaves a cell with only one possible velue, set
it. (Similarly for groups of 3, 4, etc.)
sub eliminate_open_tuple {
my $p=shift;
my $r=shift;
my $c=shift;
my $dirty=0;
my %pa;
foreach my $i (0..$#{$c}) {
my $cp=$c->[$i];
my $s=join('',sort keys %{$r->[$cp->[0]][$cp->[1]]});
if (length($s)>1) {
$pa{$s}{$i}=1;
}
}
foreach my $tuple (keys %pa) {
if (scalar keys %{$pa{$tuple}}==length($tuple)) {
my @t=split '',$tuple;
foreach my $i (0..$#{$c}) {
my $cp=$c->[$i];
unless (exists $pa{$tuple}{$i}) {
foreach my $x (@t) {
if (delete $r->[$cp->[0]][$cp->[1]]{$x}) {
$dirty=1;
}
}
if (scalar keys %{$r->[$cp->[0]][$cp->[1]]}==1) {
$p->[$cp->[0]][$cp->[1]]=(keys %{$r->[$cp->[0]][$cp->[1]]})[0];
}
}
}
}
}
return $dirty;
}
Full code on github.
Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.