Day 21 – Sudoku with Junctions and Sets

There are a number of core elements in Perl6 that give you powerful tools to do things in a concise and powerful way. Two of these are Junctions and Sets which share a number of characteristics but are also wildly different. In order to demonstrate the power of these I’m going to look at how they can be used with a simple problem, Sudoku puzzles.

Sudoku : A refresher

So for those of you who don’t know a Sudoku puzzle is a 9 by 9 grid that comes supplied with some cells filled in with numbers between 1 and 9. The goal is to fill in all the cells with numbers between 1 and 9 so that no row, column or sub square has more than one of any of the numbers in it.

There’s a few ways to represent a Sudoku puzzle, my personal favourite being a 9 by 9 nested array for example :

my @game = [
    [4,0,0,0,0,0,0,0,0],
    [0,9,0,3,4,6,0,5,0],
    [5,8,0,0,9,0,0,0,6],
    [0,4,0,8,1,3,0,0,9],
    [0,0,0,5,0,4,0,0,0],
    [8,0,0,6,2,9,0,4,0],
    [3,0,0,0,5,0,0,6,2],
    [0,5,0,9,3,2,0,8,0],
    [0,0,0,0,0,0,0,0,1]
];

In this situation the cells with no value assigned are given a 0, this way all the cells have an Integer value assigned to them. The main thing to bear in mind with this format is you need to reference cells using @game[$y][$x] rather than @game[$x][$y].

Junctions : Quantum Logic Testing

One of the simplest ways to use Junctions in Perl6 is in a logical test. The Junction can represent a selection of values you are wanting to test against. For example :

if ( 5 < 1|10 < 2 ) { say "Spooky" } else { say "Boo" }
Spooky

So, not only does this demonstrate operator chaining (something that experienced programmers may already be looking confused about) but the any Junction ( 1|10 ) evaluates to True for both 5 < 10 and 1 < 2. In this way Junctions can be extremely powerful already, it’s when you assign a variable container to them that it gets really interesting.

One of the tests we’d like to be able to make on our Sudoku puzzle is to see if it’s full. By which I mean every cell has been assigned a value greater than 0. A full puzzle may not be completed correctly but there’s a guess in each cell. Another way of putting that would be that none of the cells has a value of 0. Thus we can define a Junction and store it in a scalar variable we can test it at any point to see if the puzzle is full.

my $full-test = none( (^9 X ^9).map(-> ($x,$y) { 
    @game[$y][$x];
} ) );
say so $full-test == 0;
False

In this case the game has a number of 0’s still in it so seeing if $full-test equals 0 evaluates to False. Note that without the so to cast the result to a Boolean you’ll get a breakdown of the cells that are equal to 0 only if all of these are False will the Junction evaluate to True.

Note also the use of the ^9 and X operators to generate two Ranges from 0 to 8 and then the cross product of these two lists of 9 characters to make a list of all the possible X,Y co-ordinates of the puzzle. It’s this kind of powerful simplicity that is one of the reasons I love Perl6. But I digress.

The strength of this method is that once you’ve defined the Junction you don’t need to modify it. If you change the values stored in the Array the Junction will look at the new values instead (note this only holds true for updating individual cells, if you swap out a whole sub array with a new one you’ll break the Junction).

So that’s a simple use of a Junction so store a multi-variable test you can reuse. But it gets more interesting when you realise that the values in a Junction can themselves be Junctions.

Lets look at a more complex test, a puzzle is complete if for every row, column and square in the puzzle there is only one of each number. In order to make this test we’re going to need three helper functions.

subset Index of Int where 0 <= * <= 8; 
sub row( Index $y ) {
    return (^9).map( { ( $_, $y ) } ); 
} 
sub col( Index $x ) {
     return (^9).map( { ( $x, $_ ) } ); 
} 
multi sub square( Index $sq ) {
    my $x = $sq % 3 * 3;
    my $y = $sq div 3 * 3;
    return self.square( $x, $y );
} 
multi sub square( Index $x, Index $y ) {
     my $tx = $x div 3 * 3;
     my $ty = $y div 3 * 3;
     return ( (0,1,2) X (0,1,2) ).map( -> ( $dx, $dy ) { 
        ( $tx + $dx, $ty + $dy ) 
    } );
}

So here we define an Index as a value between 0 and 8 and then define our sub‘s to return a List of List‘s with the sub lists being a pair of X and Y indices’s. Note that our square function can accept one or two positional arguments. In the single argument we define the sub squares with 0 being in the top left then going left to right with 8 being the bottom right. The two argument version gives use the list of cells in the square for a given cell (including itself).

So with these in place we can define our one() lists for each row, column and square. Once we have them we can them put them into an all() junction.

my $complete-all = all(
     (^9).map(
        {
            |(
                one( row( $_ ).map( -> ( $x, $y ) { 
                    @game[$y][$x] 
                } ) ),
                one( col( $_ ).map( -> ( $x, $y ) { 
                    @game[$y][$x] 
                } ) ),
                one( square( $_ ).map( -> ( $x, $y ) { 
                    @game[$y][$x] 
                } ) )
            )
        }
    )
);

Once we have that testing to see if the puzzle is complete is quite simple.

say [&&] (1..9).map( so $complete-all == * );
False

Here we test each possible cell value of 1 through 9 against the Junction, in each case this will be True if all the one() Junctions contains only one of the value. Then we use the [] reduction meta-operator to chain these results to give a final True / False value (True if all the results are True and False otherwise). Again this test can be reused as you add values to the cells and will only return True when the puzzle has been completed and is correct.

Once again we’ve got a complex test boiled down to a single line of code. Our $complete-all variable needs to be defined once and is then valid for the rest of the session.

This sort of nested junction tests can reach many levels, a final example is if we want to test if a current puzzle is valid. By which I mean it’s not complete but it doesn’t have any duplicate numbers in and row, column or square. Once again we can make a Junction for this, for each row, column or square it’s valid if one or none of the cells is set to each of the possible values.  Thus our creation of the Junction is similar to the $complete-all one.

$valid-all = all(
    (^9).map(
        {
            |(
                one( 
                    none( row( $_ ).map( -> ( $x, $y ) {
                        @game[$y][$x]
                    } ) ),
                    one( row( $_ ).map( -> ( $x, $y ) {
                        @game[$y][$x]
                    } ) ) 
                ), 
                one( 
                    none( col( $_ ).map( -> ( $x, $y ) {
                        @game[$y][$x] 
                    } ) ),
                    one( col( $_ ).map( -> ( $x, $y ) { 
                        @game[$y][$x]
                    } ) ) 
                ),
                one( 
                    none( square( $_ ).map( -> ( $x, $y ) {
                        @game[$y][$x]
                    } ) ),
                    one( square( $_ ).map( -> ( $x, $y ) {
                        @game[$y][$x]
                    } ) ) 
                )
            )
        }
    )
);

The test for validity is basically the same as the test for completeness.

say [&&] (1..9).map( so $valid-all == * );
True

Except in this case our puzzle is valid and so we get a True result.

Sets : Collections of Objects

Whilst the Junctions are useful to test values they aren’t as useful if we want to try solving the puzzle. But Perl6 has another type of collection that can come in very handy. Sets, (and their related types Bags and Mixes) let you collect items and then apply mathematical set operations to them to find how different Sets interact with each other.

As an example we’ll define a possible function  that returns the values that are possible for a given cell. If the cell has a value set we will return the empty list.

sub possible( Index $x, Index $y, @game ) {
    return () if @game[$y][$x] > 0;

    ( 
        (1..9) 
            (-)
        set(
            ( row($y).map( -> ( $x, $y ) { 
                @game[$y][$x] 
            } ).grep( * > 0 ) ),
            ( col($x).map( -> ( $x, $y ) { 
                @game[$y][$x] 
            } ).grep( * > 0 ) ),
            ( square($x,$y).map( -> ( $x, $y ) { 
                @game[$y][$x] 
            } ).grep( * > 0 ) )
        )
    ).keys.sort;
 }

Here we find the different between the numbers 1 through 9 and the Set made up of the values of the row, column and square the given cell is in. We ignore cells with a 0 value using grep. As Sets store their details as unordered key / value pairs we get the keys and then sort them for consistency. Note that here we’re using the ascii (-) version of the operator, we could also use the Unicode version instead.

We could define the set as the union of each of the results from row, col and square and the result would be the same. Also we’re using the two argument version of square in this case.

It should be noted that this is the simplest definition of possible values, there’s no additional logic going on but even this simple result lets us do the simplest of solving algorithms. If this case we loop around every cell in the grid and if it’s got 1 possible value we can set the value to that. In this case we’ll loop round, get a list of cells to set, then loop through the list and set the values. If the list of ones to set is empty or the puzzle is complete then we stop.

my @updates;
repeat {
    @updates = (^9 X ^9).map( -> ($x,$y) { 
        ($x,$y) => possible($x,$y,@game) 
    } ).grep( *.value.elems == 1 );
    for @updates -> $pair { 
        my ( $x, $y ) = $pair.key; 
        @game[$y][$x] = $pair.value[0];
    }
} while ( @updates.elems > 0 && 
          ! [&&] (1..9).map( so $complete-all == * ) );

So we make a list of Pairs where the key is the x,y coordinates and the value is the possible values. Then we remove all those that don’t have one value. This is continued until there are no cells found with a single possible value or the puzzle is complete.

Another way of finding solutions is to get values that only appear in one set of possibilities in a given, row, column or square. For example if we have the following possibilities:

(1,2,3),(2,3,4),(),(),(4,5),(),(),(2,3,4),()

1 and 5 only appear in the row once each. We can make use of the symmetric set difference operator and operator chaining to get this.

say (1,2,3) (^) (2,3,4) (^) () (^) () (^) (4,5) (^) () (^) () (^) (2,3,4) (^) ()
set(1 5)

Of course in that case we can use the reduction meta-operator on the list instead.

say [(^)] (1,2,3),(2,3,4),(),(),(4,5),(),(),(2,3,4),()
set(1 5)

So in that case the algorithm is simple (in this case I’ll just cover rows, the column and square code is basically the same).

my @updates;
for ^9 -> $idx {
    my $only = [(^)] row($idx).map( -> ( $x,$y ) { 
        possible($x,$y,@game) 
    } );
    for $only.keys -> $val {
        for row($idx) -> ($x,$y) {
            if $val (elem) possible($x,$y,@game) {
                @updates.push( ($x,$y) => $val );
            }
        }
    }
}

We then can loop through the updates array similar to above. Combining these two algorithms can solve a large number of Sudoku puzzle by themselves and simplify others.

Note we have to make two passes, firstly we get the numbers we’re looking for and then we have to look through each row and find where the number appears. For this we use the (elem) operator. Sets can also be referenced using Associative references for example:

say set(1,5){1}
True

A note on Objects

So for all the examples so far I’ve used basic integers. But there’s nothing stopping you using Objects in your Junctions and Sets. There are a few things to bear in mind though, Sets use the === identity operator for their tests. Most objects will fail an identity check unless you have cloned them or have defined the WHICH method in a way that will allow them to be compared.

For the Sudoku puzzle you may want to create a CellValue class that stores whether the number was one of the initial values in the puzzle. If you do this though you’ll need to override WHICH and make it return the Integer value of the Cell. As long as you are fine with an identity check being technically invalid in this case (two different CellValues may have the same value but the won’t be the same object) then you can put them in Sets.

I hope you’ve found this interesting, Junctions and Sets are two of the many different parts of Perl6 that give you power to do complex tasks simply. If you’re interested in the code here there’s a Object based version available to use you can install with :

zef install Game::Sudoku

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s