P97 - 数独求解

Sudoku
官方模块：Problems.P97　核心函数：sudoku

表示与搜索策略

棋盘是 $9\times9$ 整数列表，0 表示空格。每轮选择候选数字最少的空格（MRV），逐个尝试；候选为空立即回溯。

实现

方法一：经典回溯

 1import Data.List (minimumBy, nub, sort, transpose)
 2import Data.Ord (comparing)
 3
 4sudoku :: [[Int]] -> Maybe [[Int]]
 5sudoku board
 6  | not (validBoard board) = Nothing
 7  | otherwise = solve board
 8  where
 9    solve current = case blanks current of
10      [] -> Just current
11      positions -> firstJust
12        [solve (setCell current position value) | value <- options]
13        where
14          position = minimumBy (comparing (length . candidates current)) positions
15          options = candidates current position
16
17blanks board = [(r,c) | r <- [0..8], c <- [0..8], board !! r !! c == 0]
18
19candidates board (r,c) =
20  [n | n <- [1..9], n `notElem` used]
21  where
22    row = board !! r
23    column = transpose board !! c
24    box = [board !! i !! j | i <- boxRange r, j <- boxRange c]
25    used = row ++ column ++ box
26    boxRange i = let start = i `div` 3 * 3 in [start..start+2]
27
28setCell board (r,c) value =
29  take r board ++ [take c row ++ [value] ++ drop (c+1) row] ++ drop (r+1) board
30  where row = board !! r
31
32validBoard board =
33  length board == 9 && all ((== 9) . length) board
34  && all (all (`elem` [0..9])) board
35  && all noDuplicates (board ++ transpose board ++ boxes board)
36  where
37    noDuplicates xs = let values = filter (/= 0) xs
38                      in length values == length (nub values)
39    boxes b = [[b !! r !! c | r <- [br..br+2], c <- [bc..bc+2]]
40              | br <- [0,3,6], bc <- [0,3,6]]
41
42firstJust [] = Nothing
43firstJust (Just value:_) = Just value
44firstJust (Nothing:rest) = firstJust rest

firstJust 返回候选列表中的第一个成功分支。

方法二：约束传播

 1sudokuWithPropagation :: [[Int]] -> Maybe [[Int]]
 2sudokuWithPropagation board
 3  | not (validBoard board) = Nothing
 4  | otherwise = solve board
 5  where
 6    solve current = do
 7      reduced <- propagate current
 8      case blanks reduced of
 9        [] -> Just reduced
10        positions -> firstJust
11          [solve (setCell reduced position value) | value <- options]
12          where
13            position = minimumBy (comparing (length . candidates reduced)) positions
14            options = candidates reduced position
15
16    propagate current
17      | not (validBoard current) = Nothing
18      | any (null . candidates current) emptyCells = Nothing
19      | null forced = Just current
20      | otherwise = propagate (foldl placeForced current forced)
21      where
22        emptyCells = blanks current
23        forced =
24          [(position, head options)
25          | position <- emptyCells
26          , let options = candidates current position
27          , length options == 1]
28        placeForced grid (position, value) = setCell grid position value

propagate 反复填入只有一个候选数字的格子，直到没有新的确定值。若某个空格没有候选，或同时填入后产生冲突，就立即回溯；只有传播无法继续时才选择候选最少的位置分支搜索。

方法对比

方法	每轮动作	特点
经典回溯	直接选择 MRV 格子分支	实现短，基准清晰
约束传播 + 回溯	先消除全部单候选	搜索树通常更小

测试

1>>> fmap (all (\row -> sort row == [1..9])) (sudoku sudokuPuzzle)
2Just True
3>>> sudoku (replicate 9 (replicate 9 1))
4Nothing
5>>> sudokuWithPropagation sudokuPuzzle == sudoku sudokuPuzzle
6True

数独搜索最坏是指数级，MRV 通常会把分支数压到很低。

参考

← P96 Ada 标识符 | P98 数织游戏 →