Weekly Challenge #086 Task #2 :: (Raku)

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🦋.

Blog