TASK #2 › Sudoku Puzzle
Submitted by: Mohammad S Anwar
You are given Sudoku puzzle (9x9).
Write a script to complete the puzzle and must respect the following rules:
a) Each row must have the numbers 1-9 occuring just once.
b) Each column must have the numbers 1-9 occuring just once.
c) The numbers 1-9 must occur just once in each of the 9 sub-boxes (3x3) of the grid.
Example:
[ _ _ _ 2 6 _ 7 _ 1 ]
[ 6 8 _ _ 7 _ _ 9 _ ]
[ 1 9 _ _ _ 4 5 _ _ ]
[ 8 2 _ 1 _ _ _ 4 _ ]
[ _ _ 4 6 _ 2 9 _ _ ]
[ _ 5 _ _ _ 3 _ 2 8 ]
[ _ _ 9 3 _ _ _ 7 4 ]
[ _ 4 _ _ 5 _ _ 3 6 ]
[ 7 _ 3 _ 1 8 _ _ _ ]
Output:
[ 4 3 5 2 6 9 7 8 1 ]
[ 6 8 2 5 7 1 4 9 3 ]
[ 1 9 7 8 3 4 5 6 2 ]
[ 8 2 6 1 9 5 3 4 7 ]
[ 3 7 4 6 8 2 9 1 5 ]
[ 9 5 1 7 4 3 6 2 8 ]
[ 5 1 9 3 2 6 8 7 4 ]
[ 2 4 8 9 5 7 1 3 6 ]
[ 7 6 3 4 1 8 2 5 9 ]
As the above puzzle respect the 3 rules including 9-sub-boxes as shown below:
[ 4 3 5 ] [ 2 6 9 ] [ 7 8 1 ]
[ 6 8 2 ] [ 5 7 1 ] [ 4 9 3 ]
[ 1 9 7 ] [ 8 3 4 ] [ 5 6 2 ]
[ 8 2 6 ] [ 1 9 5 ] [ 3 4 7 ]
[ 3 7 4 ] [ 6 8 2 ] [ 9 1 5 ]
[ 9 5 1 ] [ 7 4 3 ] [ 6 2 8 ]
[ 5 1 9 ] [ 3 2 6 ] [ 8 7 4 ]
[ 2 4 8 ] [ 9 5 7 ] [ 1 3 6 ]
[ 7 6 3 ] [ 4 1 8 ] [ 2 5 9 ]
What a interesting Task It is!!!
Well.. the method I used is simple as below
- We'll check row by row ...
- collect the numbers at which I can use each cell by removing numbers that already used (1) at the row, (2) at the same column, (3) in the same area
- try one of those candidates but also remember any possible candidates.
- as we go through the row, if failed go back to the cell at rightmost which has some candidates and choose another one and regenerate numbers on the right hand side
- when succeed to fill up the all slots, go next rows.
- If we failed, go above row again to see there are other choice.
Eh... Not very simple. is it? 😂 It is a basically brute-force solution.
Entry Point(check row by row)
A loop is used to check row by row (go up or down depends on success of fill up all slots)
...
loop ( $r = 0; 0 <= $r < 9; ) {
# note: $r can be increased or decreased
if @rc[$r].defined {
# already exists: we get here when lower case is failed
# so try next case at $r
....
}
else {
@rc[$r] = row-candidates.new( :$r,
:base(@canvas.clone));
}
if my $snp = @rc[$r].snapshot { # possible so far
@canvas[$r] = $snp;
++$r; # going next row
}
else {
# there is no more alternative case for current row
# go higher row and try next candidate if any
@rc[$r] = Nil;
@canvas = ( @rc[--$r] andthen .base
orelse Nil ); # when $r < 0
}
}
if $r < 9 {
say "Not Possible";
exit 1;
}
say "all good:" if $d;
.say for @canvas;
So when we are out of loop and $r is not last number (8)
we are unable to find the solution otherwise print out the solution
Filtering Numbers
To access area in 2 dimensional matrix, Raku provides very handy syntax 🥰
Simplest one is first, To check whole row at 0
> my @mat = <1 2 3>, <4 5 6>, <7 8 9>;
> @mat[0]
(1 2 3)
To get all elements at the column of 1 ...
> @mat[*;1]
(2 5 8)
To get all elements in the Area Grid(rule (c)) ...
if we name each grid like below
A B C
D E F
G H I
To get elements in "H", we are some range which is
row: 6 ~ 8, column : 3 ~ 6
# random example
> for ^9 { @mat[$_] = [ (1..9).pick(9) ] }
> @mat
> .say for @mat
[4 5 6 2 9 1 8 7 3]
[4 5 7 6 8 1 9 3 2]
[4 7 8 2 5 6 3 9 1]
[1 8 4 7 5 6 2 9 3]
[4 3 7 1 5 6 9 2 8]
[2 1 6 4 3 5 9 7 8]
[2 9 6 8 5 3 4 7 1]
[3 6 8 4 7 5 1 9 2]
[4 5 6 2 9 7 1 8 3]
> @mat[6..^9;3..^6]
(8 5 3 4 7 5 2 9 7)
But, please note that following is not working properly (this is the part I was struggling to debug 😱
> my $row-range = 6..^9;
6..^9
> my $col-range = 3..^6;
3..^6
> @mat[$row-range;$col-range]
(3) # ????
We have to do like below !!!
> @mat[$row-range[*];$col-range[*]]
(2 8 3 1 6 2 4 6 3)
Removing numbers
Set and SetHash used here. It was very handy
> (1..9) (-) (3,4,5)
Set(1 2 6 7 8 9)
But wait, I found another problem.
Unexpected Class: IntStr
When you get arguments from command line. or mix up the number and string in the list, Raku save values in integer value in IntStr class
> my @a = <1 2 3 4 5 6 _>
[1 2 3 4 5 6 _]
> @a.raku
[IntStr.new(1, "1"), IntStr.new(2, "2"), IntStr.new(3, "3"), IntStr.new(4, "4"), IntStr.new(5, "5"), IntStr.new(6, "6"), "_"]
This is why code below is not working !!! 👿
@a (-) (1,2,3)
Set(1 2 3 4 5 6 _)
So I had to fix by changing them in the same class. I used Str class here
> my @a = <1 2 3 4 5 6 _>>>.Str;
[1 2 3 4 5 6 _]
> @a.raku
["1", "2", "3", "4", "5", "6", "_"]
> @a (-) ('1'..'3')
Set(4 5 6 _)
Back to the Future
To record where I need to go back when met the road end, A hash used. the key is row number(index) in "Str", the value will be the possible candidates(SetHash) which looks like below(pseudo code)
> my $slots = { "a row number" => ('1'..'3').Set }
{a row number => Set(1 2 3)}
and used .grab to choose one of them randomly. (snipped code)
...
with $!cnd andthen $!cnd.sort.tail { # cnd -> candidates
# .key: column num; .value: candidates(SetHash)
my $n = .value.grab(1); # grab a candidate
my $i = $!slt.first(.key, :k);
...
grab() will reduce the the SetHash as well. it was handy for me.
Final Code
It is long long solution. so, I'll leave the full code here for anyone interested. I didn't want to use class at first because IMHO -- in most of case -- reviewers had hard time to see the flow of the code written in OOP. OOP is necessary. but sometimes it only makes us hard to read the code.
I was really longing for the Perl accepting one of popular modules like Moose, Mouse, Moo, .. etc, however, in about 10 years later, now I can see this is maybe why Perl didn't really adopt a modern way to making a class.
In short, OOP paradigm is not really for everyone (or every case).
However, I decided to use class in this solution. otherwise I need to use another kind of container related to "A" row information.
#!/usr/bin/env raku
# test with:
# raku ch-2.raku --debug=False # otherwise it will show debug output as well.
# example is built-in this case for (maybe) easier review
# note: this is a non-recursive implementaion
# entry point is localted in MAIN()
class row-candidates {
has ( Hash $!cnd, Int $!r ); # candidates, row number
has Set ( $!nar, @!nac, @!naa ); # N/A(na) number in (r)ow, (c)olumn
# and (a)rea
has Array ( $.base, # base for all rows
$!drf, # draft for current row only
$!slt, # slots (where we need to fill up)
$!cur, ); # current values in slots
submethod BUILD (:$r, :$base where { 0 <= $r < 9 }) {
$!r = $r;
if $d {
say "base matrix for row[$r]:";
.say for $base.Array
}
$!base = $base.clone; # copy whole matrix.
my \ro = $!base[$!r]>>.Str; # : orginally IntStr,
# which makes Set or SetHash compare
# with Set of Int
# please also refer NOTE1.
# IntStr is sometimes very annoying :(
my $rgr = do given $!r div 3 { 3* $_ ..^ 3* $_.succ }; # rows in the
# same area
# generate unavailable number for row, column*s* area*s*)
$!nar = ro.Set;
for ^9 { @!nac[$_] = $!base[*;$_]>>.Str.Set }
for ^3 {
my $rgc = (3* $_) ..^ (3* $_.succ);
@!naa[$_] = $!base[$rgr[*];$rgc[*]]>>.Str.Set; # [*] is must!!!
#@!naa[$_].raku.say;
}
# copy draft from base
$!drf = ro.clone.Array;
$!slt = $!drf.grep({$_ eq '_'}, :k).Array; # register slots as idx
$!cur = (Nil xx $!slt).Array; # prepare spaces
# and fill up the slots with available numbers for the first time
self.fill-slots;
}
method fill-slots {
# NOTE1 $!nar stored as .Str so (1..9) must be all .Str
my $avn = (('1'..'9') ∖ $!nar).SetHash; # available numbers in row
my $avn0 = $avn; # backup
# find the the column number where we start to fill up
# (where no current value is set at rightmost) or // zero
loop ( my $si = ($!cur.first({.defined}, :end, :k) andthen .succ) // 0;
$si < $!slt.elems; ) {
my $c = $!slt[$si];
my $an = $c div 3; # area number ( 0 | 1 | 2 )
my $avn1 = ( [∖] $avn, # (+) available numbers in row
$!cur.grep({.defined}),# (-) remove number used one
@!naa[$an], # (-) numbers used in area
@!nac[$c], # (-) numbers used in column
).SetHash;
if $d {
say "[$!r;$c] si: $si, c: $c; area num: $an";
say "[$!r:$c] avn: $avn, naa: @!naa[$an], nac: @!nac[$c]";
say "[$!r;$c]:{self.snapshot(:force)}: "~
"cur => {$!cur.map({.defined??$_!!'?'})} avn' => $avn1";
}
if $avn1.elems.so {
my $n = $avn1.grab(1); # note: returned as Seq
$!cur[$si] = $n[0]; # -> so take first elem
$!cnd{$c} = $avn1.clone # update candidates
if $avn1.elems.so;
$avn ∖= $n; # reduce avaiable num
++$si;
}
else {
my $i;
if $!cnd andthen .elems.not # no more candis: failed
or ( $i = self!forward_ )
!~~ any(Str,Int) { # forward_ will return index
# or Nil when failed to forward_
Nil.return;
}
$si = 1 + $i;
# reset available numbers
$avn = $avn0;
}
}
if $d {
say "[$!r] all filled up:";
say self.snapshot;
if $!cnd andthen .elems.so {
say "... still have candiates: {$!cnd.raku}";
}
else {
say "... but this is last case of row $!r";
}
}
True # succeed to fill up
}
method snapshot (Bool :$force = False) {
my $dup = $!drf.clone;
if $force.not and
$!cur.grep({.defined}).elems != $!slt.elems {
Nil.return;
}
else {
$dup[|$!slt] = $!cur.map({$_//'?'}).Array;
}
$dup
}
# forward_: try to set up next possible case
method !forward_ {
# find the slot has candidates at rightmost
with $!cnd andthen .sort.tail {
# .key: column num; .value: candidates(SetHash)
my $n = .value.grab(1); # grab a candidate
my $i = $!slt.first(.key, :k);
my $o = $!cur[$i];
$!cur[$i] = $n[0]; # put into current value
$!cur[$i.succ ..*] = Nil,Nil...*; # undefine values
$!cnd{.key}:delete if .value.elems.not; # remove empty info
say "[$!r;{.key}] change $o to $n"~
" and rest candidatess: {$!cnd.raku}" if $d;
$i.return # return changed index
# in $!cur
}
Nil
}
method forward {
self!forward_
andthen {
self.fill-slots.
return # repect the return value from fill-slots()
}
Nil
}
}
our $d is export;
sub MAIN ( Bool :$debug = True ) {
$d = $debug;
my @s =
#0 1 2 3 4 5 6 7 8
<_ _ _ 2 6 _ 7 _ 1>,
<6 8 _ _ 7 _ _ 9 _>,
<1 9 _ _ _ 4 5 _ _>,
<8 2 _ 1 _ _ _ 4 _>,
<_ _ 4 6 _ 2 9 _ _>,
<_ 5 _ _ _ 3 _ 2 8>,
<_ _ 9 3 _ _ _ 7 4>,
<_ 4 _ _ 5 _ _ 3 6>,
<7 _ 3 _ 1 8 _ _ _>;
my Int $r = 0;
my @canvas = @s.Array;
my @rc;
#################
## entry point ##
#################
loop ( $r = 0; 0 <= $r < 9; ) {
# note: $r can be increased or decreased
if @rc[$r].defined {
# already exists: we get here when lower case is failed
# so try next case at $r
@rc[$r].forward orelse {
# go higher if failed
@rc[$r] = Nil; # remove all row candiates
@canvas = (@rc[--$r] andthen .base.Array) // @s.Array;
next;
}
}
else {
@rc[$r] = row-candidates.new( :$r,
:base(@canvas.clone));
}
if my $snp = @rc[$r].snapshot { # possible so far
@canvas[$r] = $snp;
++$r; # going next row
}
else {
# there is no more alternative case for current row
# go higher row and try next candidate if any
@rc[$r] = Nil;
@canvas = ( @rc[--$r] andthen .base
orelse Nil ); # when $r < 0
}
}
if $r < 9 {
say "Not Possible";
exit 1;
}
say "all good:" if $d;
.say for @canvas;
}
Summer is coming in Sydney, I'm getting busier. so maybe I am not able to blog or write more code in other languages as I did before. but I'll try my best !!
Thank you for reading ~~ !!!
Take care and Peace!
If you have a time, please visit at 🐪PWC🦋.
Top comments (0)