Thinking Functionally with Haskell (17 page)

filter (p . f) = map f . filter p . map f

filter (p . f) . map f = map f . filter p

The second law follows from the first (Why?). Here is the proof of the first law:

map f . filter p . map f

=
{we proved in the previous chapter that

filter p . map f = map f . filter (p . f)
}

map f . map f . filter (p . f)

=
{functor law of
map
and
f . f = id
}

filter (p . f)

Now for the main calculation. The starting point is to use the definition of
valid
to rewrite the expression
filter valid . expand
in the form

filter valid . expand

= filter (all nodups . boxs) .

filter (all nodups . cols) .

filter (all nodups . rows) . expand

The order in which the filters appear on the right is not important. The plan of attack is to send each of these filters into battle with
expand
. For example, in the
boxs
case we can calculate:

filter (all nodups . boxs) . expand

=
{above law of
filter
, since
boxs . boxs = id
}

map boxs . filter (all nodups) . map boxs . expand

=
{since
map boxs . expand = expand . boxs
}

map boxs . filter (all nodups) . expand . boxs

=
{definition of
expand
}

map boxs . filter (all nodups) . cp . map cp . boxs

=
{since
filter (all p) . cp = cp . map (filter p)
}

map boxs . cp . map (filter nodups) . map cp . boxs

=
{functor law of
map
}

map boxs . cp . map (filter nodups . cp) . boxs

Now we use the property

filter nodups . cp = filter nodups . cp . pruneRow

to rewrite the final expression in the form

map boxs . cp . map (filter nodups . cp . pruneRow) . boxs
The remaining steps essentially repeat the calculation above, but in the reverse direction:

map boxs . cp . map (filter nodups . cp . pruneRow) . boxs
=
{functor law of
map
}

map boxs . cp . map (filter nodups) .

map (cp . pruneRow) . boxs

=
{since
cp . map (filter p) = filter (all p) . cp
}

map boxs . filter (all nodups) . cp .

map (cp . pruneRow) . boxs

=
{functor law of
map
}

map boxs . filter (all nodups) .

cp . map cp . map pruneRow . boxs

=
{definition of
expand
}

map boxs . filter (all nodups) .

expand . map pruneRow . boxs

=
{law of
filter
since
boxs . boxs = id
}

filter (all nodups . boxs) . map boxs .

expand . map pruneRow . boxs

=
{since
map boxs . expand = expand . boxs
}

filter (all nodups . boxs) . expand .

boxs . map pruneRow . boxs

=
{introducing
pruneBy f = f . pruneRow . f
}

filter (all nodups . boxs) . expand . pruneBy boxs

We have shown that

filter (all nodups . boxs) . expand

= filter (all nodups . boxs) . expand . pruneBy boxs

where
pruneBy f = f . map pruneRow . f
. Repeating the same calculation for rows and columns, we obtain
filter valid . expand = filter valid . expand . prune

where

prune = pruneBy boxs . pruneBy cols . pruneBy rows

In conclusion, the previous definition of
solve
can now be replaced with a new one:
solve = filter valid . expand . prune . choices

In fact, rather than have just one
prune
we can have as many prunes as we like. This is sensible because after one round of pruning some choices may be resolved into singleton choices and another round of pruning may remove still more impossible choices.

So, let us define

and redefine
solve
once again to read

solve = filter valid . expand . many prune . choices

The simplest Sudoku problems are solved just by repeatedly pruning the matrix of choices until only singleton choices are left.

The result of
many prune . choices
is a matrix of choices that can be put into one of three classes: 1. A
complete
matrix in which every entry is a singleton choice. In this case
expand
will extract a single grid that can be checked for validity.

2. A matrix that contains the empty choice somewhere. In this case
expand
will produce the empty list.

3. A matrix that does not contain the empty choice but does contain some entry with two or more choices.

The problem is what to do in the third case. Rather than carry out full expansion, a more sensible idea is to make use of a partial expansion that installs the choices for just one of the entries, and to start the pruning process again on each result. The hope is that mixing pruning with single-cell expansions can lead to a solution more quickly. Our aim therefore is to construct a partial function
expand1 :: Matrix [Digit] -> [Matrix [Digit]]

that expands the choices for one cell only. This function will return well-defined results only for incomplete matrices, and on such matrices is required to satisfy
expand = concat . map expand . expand1

Actually this equality between two lists is too strong. We want to ensure that no possible choice is lost by partial expansion, but do not really care about the precise order in which the two sides deliver their results. So we will interpret the equation as asserting the equality of the two sides up to some permutation of the answers.

Which cell should we perform expansion on? The simplest answer is to find the first cell in the matrix with a non-singleton entry. Think of a matrix
rows
broken up as follows:

rows = rows1 ++ [row] ++ rows2

row = row1 ++ [cs] ++ row2

The cell
cs
is a non-singleton list of choices in the middle of
row
, which in turn is in the middle of the matrix
rows
.

Then we can define

To break up the matrix in this way, we use the prelude function
break
:
break :: (a -> Bool) -> [a] -> ([a],[a])

break p = span (not . p)

The function
span
was defined in
Section 4.8
. For example,
ghci> break even [1,3,7,6,2,3,5]

([1,3,7],[6,2,3,5])

We also need the standard prelude function
any
, defined by

any :: (a -> Bool) -> [a] -> Bool

any p = or . map p

where
or
takes a list of booleans and returns
True
if any element is
True
, and
False
otherwise:

or :: [Bool] -> Bool

or []
= False

or (x:xs) = x || or xs

Finally, the
single
test is defined (using don’t care patterns) by

single :: [a] -> Bool

single [_] = True

single _
= False

Now we can define

The first
where
clause breaks a matrix into two lists of rows with the row at the head of the second list being one that contains a non-singleton choice. A second appeal to
break
then breaks this row into two lists, with the head of the second list being the first non-singleton element. If the matrix contains only singleton entries, then
break (any (not . single)) rows = [rows,[]]

and execution of
expand1
returns an error message.

The problem with this definition of
expand1
is that it can lead to wasted work. If the first non-singleton entry found in this way happens to be the empty list, then
expand1
will return the empty list, but if such a list is buried deep in the matrix, then
expand1
will do a lot of useless calculation trying to find a solution that isn’t there. It is arguable that a better choice of cell on which to perform expansion is one with the
smallest
number of choices (not equal to 1 of course). A cell with no choices means that the puzzle is unsolvable, so identifying such a cell quickly is a good idea.

The change to
expand1
to implement this idea is as follows:

expand1 :: Matrix [Digit] -> [Matrix [Digit]]

expand1 rows

= [rows1 ++ [row1 ++ [c]:row2] ++ rows2 | c <- cs]

where

(rows1,row:rows2) = break (any smallest) rows

(row1,cs:row2)
= break smallest row
smallest cs
= length cs == n

n
= minimum (counts rows)

The function
counts
is defined by
counts = filter (/= 1) . map length . concat

The value
n
is the smallest number of choices, not equal to 1, in any cell of the matrix of choices. We will leave the definition of
minimum
as an exercise. The value of
n
will be 0 if the matrix has an empty choice entry anywhere, and in this case
expand1
will return the empty list. On the other hand, if the matrix of choices contains only singleton choices, then
n
is the minimum of the empty list, which is the undefined value ⊥. In this case
expand1
will also return ⊥, so we had better ensure that
expand1
is applied only to incomplete matrices. A matrix is incomplete if it does not satisfy
complete
:

complete :: Matrix [Digit] -> Bool

complete = all (all single)

We can also usefully generalise
valid
to a test on matrices of choices. Suppose we define
safe
by

safe :: Matrix [Digit] -> Bool

safe m = all ok (rows cm) &&

all ok (cols cm) &&

all ok (boxs cm)

ok row = nodups [x | [x] <- row]

A matrix is safe if none of the singleton choices in any row, column or box contain duplicates. But a safe matrix may contain non-singleton choices. Pruning can turn a safe matrix into an unsafe one, but if a matrix is safe after pruning it has to be safe beforehand. In symbols,
safe . prune = safe
. A complete and safe matrix yields a solution to the Sudoku problem, and this solution can be extracted by a simplified version of
expand
:

extract :: Matrix [Digit] -> Grid

extract = map (map head)

Hence on a safe and complete matrix
m
we have

filter valid (expand m) = [extract m]

On a safe but incomplete matrix we have

up to permutation of each side. Since

filter p . concat = concat . map (filter p)
we obtain that
filter valid . expand
simplifies to
concat . map (filter p . expand) . expand1

And now we can insert a single
prune
to obtain

concat . map (filter p . expand . prune) . expand1

Hence, introducing

search = filter valid . expand . prune

we have, on safe but incomplete matrices, that

search = concat . map search . expand1 . prune

And now we can replace
solve
by a third version:

This is our final simple Sudoku solver. We could replace
prune
in the last line by
many prune
. Sometimes many prunes work faster than one prune; sometimes not. Note that the very first safety test occurs immediately after one round of pruning on the installed choices; consequently flawed input is detected quickly.

Exercise A