Weekly Challenge #086 Task #2 :: (Raku) 
Tags: perlweeklychallenge, challenge, raku, perl
Published: 2020-11-13 11:41:48

## [**TASK #2 › Sudoku Puzzle**](https://perlweeklychallenge.org/blog/perl-weekly-challenge-086/#TASK2)
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
> 0. We'll check row by row ...
> 1. 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
> 2. try one of those candidates but also remember any possible candidates.
> 3. 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
> 4. when succeed to fill up the all slots, go next rows.
> 5. 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)

```perl
...
    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
```perl
> 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
```perl
# 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 😱

```perl
> 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 !!!
```perl
> @mat[$row-range[*];$col-range[*]]
(2 8 3 1 6 2 4 6 3)
```

### **Removing numbers**
[Set](https://docs.raku.org/type/Set) and [SetHash](https://docs.raku.org/type/SetHash) used here. It was very handy

```perl
> (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

```perl
> 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 !!! 👿
```perl
@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
```perl
> 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)
```perl
> my $slots = { "a row number" => ('1'..'3').Set }
{a row number => Set(1 2 3)}
```

and used [.grab](https://docs.raku.org/routine/grab) to choose one of them randomly. (snipped code)
```perl
...
       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.

```perl
#!/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🦋](https://perlweeklychallenge.org).