Haskell数独求解器

Question

我是函数式编程的初学者，我在Haskell做了一个数独求解器。 Sudokus包含为[(posX,posY),value)]，如果一个位置为空，它不在列表中。

目前我有一个功能，step :: Sudoku -> [Sudoku]。如果数独已经解决了，它会返回一个包含该数独的元素列表。如果它尚未解决，但可以，它会检查可以清楚写入的第一个空白位置（所以只有一个正确的数字），并将其添加到数独中。如果没有这样的空白点（所以多个数字都适合），它会得到第一个空白点，并使包含多个数字的列表包含多个不同的有效变化。最后，如果数独不能解决，它会返回一个空列表。

我知道它很累，但这是我被分配去做的，所以请耐心等待。我接下来要做的是写一个实际的求解函数，使用step（这实际上只是解决它的一个步骤），它必须是这样的：solve :: Sudoku -> [Sudoku]。它得到一个数独，并返回列表中的所有可能的解决方案。

问题是我不知道如何。这可能是一个使用黑魔法的递归，我无法理解它。

在此先感谢。

编辑：这是完整的源代码，我想出了最后一个函数，但是目前它非常慢。有什么办法可以让速度更快吗？

type Pos = (Int, Int) 
type Cell = (Pos, Int) 
type Sudoku = [Cell] 
type Block = Int 

--example: 
sudoku :: Sudoku 
sudoku = [((0,0),3),((0,1),6),((0,4),7),((0,5),1),((0,6),2), 
      ((1,1),5),((1,6),1),((1,7),8), 
      ((2,2),9),((2,3),2),((2,5),4),((2,6),7), 
      ((3,4),1),((3,5),3),((3,7),2),((3,8),8), 
      ((4,0),4),((4,3),5),((4,5),2),((4,8),9), 
      ((5,0),2),((5,1),7),((5,3),4),((5,4),6), 
      ((6,2),5),((6,3),3),((6,5),8),((6,6),9), 
      ((7,1),8),((7,2),3),((7,7),6), 
      ((8,2),7),((8,3),6),((8,4),9),((8,7),4),((8,8),3)] 

--returns a list of numbers already used in a row 
numsInRow :: Sudoku -> Int -> [Int] 
numsInRow sud n = [ i | ((x,y), i) <- sud, x==n ] 

--returns a list of numbers already used in a column 
numsInCol :: Sudoku -> Int -> [Int] 
numsInCol sud n = [ i | ((x,y), i) <- sud, y==n ] 

--returns the index of a block (goes from 0 to 8) in which the given position is contained 
posToBlock :: Pos -> Block 
posToBlock (x,y) = x - (x `mod` 3) + y `div` 3 

--returns all the positions in a block 
blockToPositions :: Block -> [Pos] 
blockToPositions n 
    | n `notElem` [0..8] = error ("blockToPositions: bad block number " ++ show n) 
    | otherwise = [ (x,y) | x <- [0..8], y <- [0..8], n == (x - (x `mod` 3) + y `div` 3) ] 

--returns the numbers already used in a block 
numsInBlock :: Sudoku -> Block -> [Int] 
numsInBlock sud n = [ i | ((x,y), i) <- sud, (j,k) <- blockToPositions n, (x,y) == (j,k)] 

--decides if all the elements are unique in a list 
allUnique :: Eq a => [a] -> Bool 
allUnique [] = True 
allUnique (x:xs) 
    | x `elem` xs = False 
    | otherwise = allUnique xs 

--returns if a sudoku is valid, so it is 9x9, all the values are between 1 and 9, and there are no repeating numbers in any row, column, or block 
isSudokuPuzzle :: Sudoku -> Bool 
isSudokuPuzzle sud = and [and [ x `elem` [0..8] && y `elem` [0..8] && z `elem` [1..9] | ((x,y), z) <- sud ] , and [ allUnique a | a <- [numsInRow sud i | i <- [0..8] ]] , and [ allUnique a | a <- [numsInCol sud i | i <- [0..8] ]] , and [ allUnique a | a <- [numsInBlock sud i | i <- [0..8] ]]] 

--returns if a sudoku is filled, so all the fields have values (and only one value) 
isFilled :: Sudoku -> Bool 
isFilled sud = allUnique [ (x,y) | ((x,y), z) <- sud ] && length [ (x,y) | ((x,y), z) <- sud ] == 81 

--a sudoku is solved if it is a valid sudoku and filled 
isSolved :: Sudoku -> Bool 
isSolved sud = isSudokuPuzzle sud && isFilled sud 

--decides if a position is blank (has no value, not filled) in a sudoku 
isBlank :: Sudoku -> Pos -> Bool 
isBlank sud (x,y) = (x,y) `notElem` [ (j,k) | ((j,k),l) <- sud ] 

--gives back a list of all empty positions in a sudoku 
blankPositions :: Sudoku -> [Pos] 
blankPositions sud = [ (x,y) | x <- [0..8], y <- [0..8], isBlank sud (x,y) ] 

--returns a list of all valid numbers in a position (empty if position is already filled) 
possibleNumsOnPos :: Sudoku -> Pos -> [Int] 
possibleNumsOnPos sud (x,y) 
    | isBlank sud (x,y) = [ i | i <- [1..9], i `notElem` numsInRow sud x, i `notElem` numsInCol sud y, i `notElem` numsInBlock sud (posToBlock (x,y)) ] 
    | otherwise = [] 

--returns a list of all the blank positions and their possible values in a sudoku 
possibleNumsForBlankPos :: Sudoku -> [(Pos, [Int])] 
possibleNumsForBlankPos sud = [ ((x,y), possibleNumsOnPos sud (x,y)) | x <- [0..8], y <- [0..8], isBlank sud (x,y)] 

--dedices if a sudoku has a solution (so there is still at least one blank and it has at least one valid value) 
hasSolution :: [(Pos, [Int])] -> Bool 
hasSolution [] = False 
hasSolution a = and [ not (null l) | ((j,k),l) <- a ] 

--returns a list of blanks that have only one possible valid value 
uniqueNumForBlankPos :: [(Pos, [Int])] -> [(Pos, Int)] 
uniqueNumForBlankPos a = [ ((j,k),head l) | ((j,k),l) <- a, length l == 1 ] 

--fills a field in a sudoku with a given value 
insertElem :: Sudoku -> Pos -> Int -> Sudoku 
insertElem sud (x,y) n 
    | isBlank sud (x,y) = ((x,y),n):sud 
    | otherwise = error ("insertElem: position " ++ show (x,y) ++ " is not blank") 


--If the sudoku is already solved, it returns a single element list containing that sudoku. 
--If it is not already solved, but can be, it checks for the first blank position that has only one possible valid value, and adds it to the sudoku. 
--If there is no such blank point (so all blanks have multiple valid values), it gets the first blank point and makes a list containing multiple sudokus with all the different, valid variations of that point. 
--Lastly, if the sudoku cannot be solved, it returns an empty list. 
step :: Sudoku -> [Sudoku] 
step sud 
    | isSolved sud = [sud] 
    | hasSolution (possibleNumsForBlankPos sud) && not (null (uniqueNumForBlankPos (possibleNumsForBlankPos sud))) = [ insertElem sud (fst (head (uniqueNumForBlankPos (possibleNumsForBlankPos sud)))) (snd (head (uniqueNumForBlankPos (possibleNumsForBlankPos sud)))) ] 
    | hasSolution (possibleNumsForBlankPos sud) && null (uniqueNumForBlankPos (possibleNumsForBlankPos sud)) = [ insertElem sud (head (blankPositions sud)) x | x <- possibleNumsOnPos sud (head (blankPositions sud)) ] 
    | not (hasSolution (possibleNumsForBlankPos sud)) = [] 

--It gets a sudoku, and returns all the possible solutions in a list, but currently it is very slow. 
solve :: Sudoku -> [Sudoku] 
solve sud 
    | not (isSudokuPuzzle sud) = error "solve: improper sudoku" 
    | otherwise = 
    until done f l 
     where 
     l = return sud 
     f (x:xs) = (f xs) ++ step x 
     f [] = [] 
     done m = and (map isSolved m) && and (map isSudokuPuzzle m) 

Answer 1

分解成以下步骤：

1. 你怎么能判断一个部分解决方案是最终的解决方案？简单：由于Sudoku是一个填充位置列表，完成的解决方案是一个包含81个元素的列表。 （假设一个标准的9x9数独谜题）。

   任务：写isFinished :: Sudoku -> Bool

2. 给出的解决方案，你怎么知道你什么时候做一个列表？简单：列表中的每个解决方案都是完成的解决方案。你可以直接测试，或检查是否x == (step x)。

   任务：编写partials :: [Sudoku] -> [Sudoku]，它从输入中删除完成的解决方案。

3. 要处理解决方案列表，您需要对每个解决方案应用step并收集结果。这正是列表monad最适合的计算类型：partial_solutions >>= step。

4. 要实现solve :: Sudoku -> [Sudoku]，它有助于写solve' :: [Sudoku] -> [Sudoku]，其中solve initState = solve' [initState]。如果你记住1-3以上，那么它本身是一个相当简单的递归函数。