Haskell 在第一次失败后，我如何才能使这个数独算法解卡？

我在玩一个数独游戏，如下所示。我遇到的问题是，在第一次尝试失败后，我不知道如何使用回溯使解算器返回。如最后一个代码片段所示，当算法命中第一个非法解决方案时停止，并返回

Nothing

。我怎样才能让它返回并尝试另一种解决方案，直到找到为止

-- Updates a specific sudoku with a value at a specific position
update :: Sudoku -> Pos -> Maybe Int -> Sudoku

-- Returns all the blank possitions in a sudoku
blanks :: Sudoku -> [Pos]

-- checks so that the size is correct 9x9
isSudoku :: Sudoku -> Bool

-- Checks if it is a legal sudoku, no number twise on any line col or box
isOkay :: Sudoku -> Bool

-- Checks if there are no empty cells in the sudoku
isSolved :: Sudoku -> Bool


solve :: Sudoku -> Maybe Sudoku
solve s
  | not $ isSudoku s && isOkay s = Nothing
  | otherwise = solve' $ pure s

solve' :: Maybe Sudoku -> Maybe Sudoku
solve' Nothing = Nothing --There is no solution
solve' (Just  s)
  | isSolved s = pure s -- We found a solution
  | otherwise = solve' newSud -- Continue looking for solution
    where
      (p:_) = blanks s
      newSud = solveCell (candidates s p)
      solveCell [] =  Nothing
      solveCell (c:cs)
        | isOkay $ update s p (pure c) = Just $ update s p (pure c)
        | otherwise = solveCell cs

解决失败，并以此作为停止点

Just (Sudoku {rows = [
[Just 1,Just 2,Just 3,Just 4,Just 5,Just 6,Just 7,Just 8,Just 9],
[Just 4,Just 5,Just 6,Just 1,Just 2,Just 3,Just 8,Just 7,Nothing]
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing],
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing],
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing],
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing],
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing],
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing],
[Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing]]})

---

我将通过编写更多的通用代码来简化这个问题。编写更通用的代码通常更容易，因为可能性更小

要进行一般性搜索，我们需要三件事：如何判断何时使用类型

a->Bool

完成

搜索，使用类型
a->[a]
搜索有哪些
分支，以及使用类型
a
从何处开始搜索

深度优先搜索
我们正在努力实施的a战略很简单。如果
已完成
，请返回找到的结果。否则，找出我们可以从这里获取的分支，并尝试按顺序搜索每个分支，直到其中一个返回结果。如果没有分支，我们就无法找到结果

import Data.Maybe

depthFirstSearch :: (a -> Bool) -> (a -> [a]) -> a -> Maybe a
depthFirstSearch done branches = go
    where 
        go x =
            if done x
            then Just x
            else listToMaybe . catMaybes . map go . branches $ x

深度优先搜索的典型实现，如我们的，通常使用调用堆栈进行回溯。深度优先搜索在探索其他可能的决策之前，先探索决策产生的所有可能性。由于它提交到一个操作过程，或者解决了问题，或者证明了操作过程是不可解的，因此提交到每个操作过程之前的状态可以很容易地存储在堆栈上。堆栈在进行调用之前会记住计算的状态，以便在调用返回时恢复该状态。这是一个完美的匹配状态，我们需要记住的回溯深度优先搜索

listtomabe的评估。猫咪。地图开始。分支
是由惰性求值驱动的，因此最左边的事情总是首先发生的
listToMaybe
正在寻找第一个解决方案，从
catMaybes尝试各种可能性。地图开始。依次分支
，直到找到一个
catMaybes
正在生成
map go的结果。分支
，抛出了一种探索过的可能性，结果是什么都没有
map go
根据其他函数的要求，对每个分支进行递归调用

深度优先搜索数独
要使用
depthFirstSearch
解决数独问题，我们需要提供
done
和
分支
函数。我们已经
完成了
，它已经
解决了
。我们需要提供
分支
功能，用于从一个位置查找合法移动。首先，我们将找到所有的
移动

-- You might have something more clever for this
candidates :: Sudoku -> Pos -> [Int]
candidates _ _ = [1..9] 

moves :: Sudoku -> [Sudoku]
moves s = do
    -- We only need to consider putting all the numbers in one position, not putting all the numbers in all positions
    p <- take 1 . blanks $ s
    c <- candidates s p
    return (update s p (Just c))

这足以使用
depthFirstSearch

solve' :: Sudoku -> Maybe Sudoku
solve' = depthFirstSearch isSolved legalMoves

与代码的差异
让我们看看上面的
solve'
与您的
solve'
有何不同。它们都使用相同的部分-
isSolved
，
isOkay
，
空格
，
候选项
和
更新
，但它们的组合略有不同

我将从上面重新编写
solve'
，直到它看起来接近您的
solve'
。首先，我们将替换
depthFirstSearch
，注意
solve'=go
，如果。。。然后。。。其他

solve' :: Sudoku -> Maybe Sudoku
solve' s
    | isSolved s = Just s
    | otherwise  = listToMaybe . catMaybes . map solve' . legalMoves $ s

我将在

legalMoves

solve' :: Sudoku -> Maybe Sudoku
solve' s
    | isSolved s = Just s
    | otherwise  = listToMaybe . catMaybes . map solve' $ newSuds
        where
            newSuds = filter isOkay $ do
                -- We only need to consider a single putting all the numbers in one position, not puutting all the numbers in all positions
                p <- take 1 . blanks $ s
                c <- candidates s p
                return (update s p (Just c))

我们可以将

update

移动到

tryInTurn

，但我们必须以某种方式跟踪

p

，或者像您那样假设

未解决

意味着

空白

将不会被

[]

。我们会做后一件事，这就是你所做的

solve' :: Sudoku -> Maybe Sudoku
solve' s
    | isSolved s = Just s
    | otherwise = solveCell (candidates s p)
        where
            (p:_) = blanks s
            solveCell  [] = Nothing
            solveCell  (c:cs)
                | isOkay $ update s p (Just c) = 
                    case solve' (update s p (Just c)) of
                        (Just solution) -> Just solution
                        otherwise       -> solveCell cs
                | otherwise = solveCell cs

此版本与您的版本之间的最大区别在于，对每个候选对象的

solve'

递归调用只发生一次，而不是对第一个候选对象发生一次

实际问题

---

深度优先数独解算器在处理数独中绝对巨大的分支因子时会遇到很多麻烦。对于限制最少的移动启发法来说，它可能是成立的，对于数独来说，这将是选择在最少的合格候选位置进行下一步操作。

您的

数独

数据结构不够强大。它相当于二维数组的

可能是Int

，但对于每个单元格，您需要跟踪所有可能的数字，例如：

data Sudoku = Sudoku { rows :: [[ [Int] ]] }

然后关键是编写一个

消除

函数，消除单元格中的可能性：

eliminate :: Sudoku -> (Int,Int) -> Int -> Maybe Sudoku
eliminate s ((i,j),d) = ...

删除

不仅需要从

（i，j）

处的单元格中删除数字

d

，还需要在同一行、列和框中执行推断，以查看是否可以从其他单元格中删除任何其他数字

update

功能可以按照

remove

编写，如下所示：

update :: Sudoku -> (Int,Int) -> Int -> Maybe Sudoku
update sud (i,j) d =
  let ds = ...digits in sud at (i,j)...
      toDump = delete d ds  -- the digits to remove
      foldM (\s x -> eliminate s (i,j) x) sud toDump

这里，

foldM

通过依次调用

elime

对

toDump

中的数字进行迭代。如果

消除

返回

无

，折叠将提前终止

我所介绍的是基于这一点的，而这一点又是基于这一点的，它包含了对该方法的极好解释。

---

要查看回溯是如何完成的，请查阅Haskell源代码中的

搜索功能。
好的，您需要某种状态或历史来回溯。现在，它只点击
Nothing
，不记得上一次迭代的任何内容（没有双关语）。你应该考虑使用<代码>状态>代码>单元格，或者更好的是，你可以使用一个单元格。我必须能够使用嵌套递归来实现这一点吗？我只是不知道我该怎么做
eliminate :: Sudoku -> (Int,Int) -> Int -> Maybe Sudoku
eliminate s ((i,j),d) = ...

update :: Sudoku -> (Int,Int) -> Int -> Maybe Sudoku
update sud (i,j) d =
  let ds = ...digits in sud at (i,j)...
      toDump = delete d ds  -- the digits to remove
      foldM (\s x -> eliminate s (i,j) x) sud toDump