type Matrix a = [[a]]
type Grid = Matrix Int

choicesComp :: Grid -> Matrix [Int]
choicesComp rows =
  [[[d | d <- [1..9], n == 0 || d == n] | n <- row] | row <- rows]
The input contract restricts each cell to zero or a digit from one to nine. A definition using standard list functions is:
choicesMap :: Grid -> Matrix [Int]
choicesMap = map (map choice)
  where
    choice :: Int -> [Int]
    choice 0 = [1..9]
    choice n = [n]

choices :: Grid -> Matrix [Int]
choices = choicesMap
Both preserve the row structure and construct the initial constraint domains of the Sudoku problem. The alternative names let both definitions coexist; either can supply choices.
The recursive Cartesian product is:
cpRec :: [[a]] -> [[a]]
cpRec [] = [[]]
cpRec (xs:xss) = [x:ys | x <- xs, ys <- cpRec xss]
The corresponding right fold is:
cpFold :: [[a]] -> [[a]]
cpFold = foldr step [[]]
  where
    step :: [a] -> [[a]] -> [[a]]
    step xs acc = [x:ys | x <- xs, ys <- acc]

cp :: [[a]] -> [[a]]
cp = cpRec
The base [[]] is essential: there is one way to choose from no factors, namely the empty selection. For a nonempty outer list, choose its first coordinate and prepend it to each selection from the remaining factors. This also proves equality with the right fold by structural induction. An empty factor produces no selections.
First enumerate each possible row, then choose one row from each row's alternatives:
expand :: Matrix [a] -> [Matrix a]
expand = cp . map cp
The inner Cartesian product converts one row of cell choices into its possible rows; the outer product combines those rows into whole matrices. Every assignment is represented exactly once when each cell's alternatives are distinct. Empty cell domains yield no grids, and an empty matrix yields the singleton list containing the empty matrix.
Enumerate assignments and retain exactly the valid completions:
solve :: Grid -> [Grid]
solve = filter complete . expand . choices
With blank cells and all other entries fixed, the unpruned Cartesian product has candidate grids. Testing complete enforces every row, column and box condition. This is the size of the full candidate search; lazy evaluation can stop earlier if the caller demands only an initial portion of the solution list.
Prune until a fixed point before enumerating the surviving domains:
stable :: Eq a => (a -> a) -> a -> a
stable f x = let y = f x
             in if y == x then x else stable f y

solve :: Grid -> [Grid]
solve = filter complete . expand . stable prune . choices
New singleton cells can make a later pruning pass effective even if one pass has already run. Under the supplied deletion-only, solution-preserving contract, fixed-point pruning of finite constraint domains terminates: every changed pass strictly decreases the total number of candidates, initially at most . No valid solution is removed. An empty domain causes expand to return no candidates; a fixed point with unresolved alternatives still needs enumeration and the final complete test.

Ancestors (10)

  1. Functional programming, design and analysis of algorithms
  2. 2017
  3. Past exam of the year 1 of the computer science course of the University of Oxford
  4. Year 1 of the computer science course of the University of Oxford
  5. Computer science course of the University of Oxford
  6. Undergraduate course of the University of Oxford
  7. Course of the University of Oxford
  8. University of Oxford
  9. List of universities
  10. Home

View article source

Discussion (0) New discussion

There are no discussions about this article yet.

Articles by others on the same topic (0)

There are currently no matching articles.
See all articles in the same topic Create my own version