2016-04-25 79 views
-2

我是函數式編程的初學者,我在Haskell做了一個數獨求解器。 Sudokus包含爲[(posX,posY),value)],如果一個位置爲空,它不在列表中。Haskell數獨求解器

目前我有一個功能,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) 
+0

這不是黑魔法 - 一種方法是使用'do'符號作爲list-monad(它會爲你做所有的組合) - 可悲的是它不可能幫助你更多,因爲沒有單行代碼在這裏誠實地說:我不想爲你寫下完整的求解器 – Carsten

+0

如果你想欺騙你可以看看[Haskell wiki](https://wiki.haskell.org/Sudoku )或此[論文](http://www.cs.tufts.edu/~nr/cs257/archive/richard-bird/sudoku。pdf)最有可能你的練習建立在紙上 – Carsten

回答

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以上,那麼它本身是一個相當簡單的遞歸函數。

+3

或者作爲替代:1.寫'isFinished' 2.'導入Data.SBV' 3.'sat isFinished'。 –