{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Examples.NQueens where
import qualified Data.Set as S
import Props
import Data.Foldable
import Data.List
type Coord = (Int, Int)
constrainQueens :: Int -> Prop [PVar S.Set Coord]
constrainQueens n = do
let locations = S.fromList [(x, y) | x <- [0..n - 1], y <- [0..n - 1]]
let queens = replicate n locations
queenVars <- traverse newPVar queens
let queenPairs = [(a, b) | a <- queenVars, b <- queenVars, a /= b]
for_ queenPairs $ \(a, b) -> require (\x y -> not $ overlapping x y) a b
return queenVars
overlapping :: Coord -> Coord -> Bool
overlapping (x, y) (x', y')
| x == x' = True
| y == y' = True
| x - x' == y - y' = True
| x + y == x' + y' = True
| otherwise = False
showSolution :: Int -> [Coord] -> String
showSolution n (S.fromList -> qs) =
let str = toChar . (`S.member` qs) <$> [(x, y) | x <- [0..n-1], y <- [0..n-1]]
in unlines . chunksOf n $ str
where
toChar :: Bool -> Char
toChar True = 'Q'
toChar False = '.'
chunksOf :: Int -> [a] -> [[a]]
chunksOf n = unfoldr go
where
go [] = Nothing
go xs = Just (take n xs, drop n xs)
nQueens :: Int -> IO ()
nQueens n = do
let Just results = solve fmap (constrainQueens n)
putStrLn $ showSolution n results
nQueensAll :: Int -> IO ()
nQueensAll n = do
let results = solveAll fmap (constrainQueens n)
traverse_ (putStrLn . showSolution n) results