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.