Haskell数独求解器

时间:2016-04-25 17:49:05

标签: haskell sudoku

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

目前我有一个功能step :: Sudoku -> [Sudoku]。如果数独已经解决,它将返回包含该数据的单个元素列表。如果它尚未解决,但可以,它会检查可以清楚写入的第一个空白位置(因此只有一个正确的数字),并将其添加到数独。如果没有这样的空白点(因此适合多个数字),它将得到第一个空白点,并生成一个包含多个sudokus的列表,其中包含该点的所有不同的有效变体。最后,如果无法解决数独,它将返回一个空列表。

我知道这很累,但这就是我被分配去做的事情,所以请耐心等待。我接下来要做的是使用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)

1 个答案:

答案 0 :(得分:1)

将其细分为步骤:

  1. 如何判断部分解决方案是否已完成解决方案?简单:由于Sudoku是填充位置列表,因此完成的解决方案是包含81个元素的列表。 (假设标准的9x9数独谜题)。

    任务:写isFinished :: Sudoku -> Bool

  2. 鉴于解决方案列表,您如何知道何时完成?简单:列表中的每个解决方案都是完整的解决方案。您可以直接测试,或检查是否x == (step x)

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

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

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