Haskell的三种八皇后问题的解法

Posted 2021-04-25 Hello编程世界

八皇后问题是经典的问题，有很多的算法，用Haskell来解决，很有意思，值得仔细研究。

解法1：

---

safe :: Int -> [Int] -> Int -> Bool
safe _ [] _ = True
safe x (x1:xs) n = 
 x /= x1 && x /= x1 + n && x /= x1 - n && safe x xs (n+1)

queens :: Int -> [[Int]]
queens 0 = [[]]
queens n = [ x:y | y <- queens (n-1), x <- [1..8], safe x y 1]

解法2，

---

import Control.Monad
import Data.List
 
-- given n, "queens n" solves the n-queens problem, returning a list of all the
-- safe arrangements. each solution is a list of the columns where the queens are
-- located for each row
queens :: Int -> [[Int]]
queens n = map fst $ foldM oneMoreQueen ([],[1..n]) [1..n] where 
 
 -- foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
 -- foldM folds (from left to right) in the list monad, which is convenient for 
 -- "nondeterminstically" finding "all possible solutions" of something. the 
 -- initial value [] corresponds to the only safe arrangement of queens in 0 rows
 
 -- given a safe arrangement y of queens in the first i rows, and a list of 
 -- possible choices, "oneMoreQueen y _" returns a list of all the safe 
 -- arrangements of queens in the first (i+1) rows along with remaining choices 
 oneMoreQueen (y,d) _ = [(x:y, delete x d) | x <- d, safe x] where
 
 -- "safe x" tests whether a queen at column x is safe from previous queens
 safe x = and [x /= c + n && x /= c - n | (n,c) <- zip [1..] y]
 
-- prints what the board looks like for a solution; with an extra newline
printSolution y = do
 let n = length y
 mapM_ (\x -> putStrLn [if z == x then 'Q' else '.' | z <- [1..n]]) y
 putStrLn ""
 
-- prints all the solutions for 6 queens
main = mapM_ printSolution $ queens 6

解法3，基于fold

---

import Data.List (transpose, intercalate)
 
queenPuzzle :: Int -> Int -> [[Int]]
queenPuzzle nRows nCols
 | nRows <= 0 = [[]]
 | otherwise =
 foldr
 (solution a ->
 a ++
 foldr
 (iCol b ->
 if safe (nRows - 1) iCol solution
 then b ++ [solution ++ [iCol]]
 else b)
 []
 [1 .. nCols])
 []
 (queenPuzzle (nRows - 1) nCols)
 where
 safe iRow iCol solution =
 True `notElem`
 zipWith
 (sc sr ->
 (iCol == sc) || (sc + sr == iCol + iRow) || (sc - sr == iCol - iRow))
 solution
 [0 .. iRow - 1]
 
-- TEST ------------------------------------------------------------------------
-- 10 columns of solutions for the 7*7 board:
showSolutions :: Int -> Int -> [String]
showSolutions nCols nBoardSize =
 unlines <$>
 (((intercalate " " <$>) . transpose . (boardLines <$>)) <$>
 chunksOf nCols (queenPuzzle nBoardSize nBoardSize))
 where
 boardLines rows =
 (
 ->
 foldMap
 (c ->
 [ if r == c
 then '♛'
 else '.'
 ])
 [1 .. (length rows)]) <$>
 rows
 
chunksOf :: Int -> [a] -> [[a]]
chunksOf i xs = take i <$> ($ (:)) (splits xs) []
 where
 splits [] _ n = []
 splits l c n = l `c` splits (drop i l) c n
 
main :: IO ()
main = (putStrLn . unlines) $ showSolutions 10 7