1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
module Main where
import Data.List
import Data.Matrix
import System.Environment
main :: IO ()
main = do
args <- getArgs
let n = read $ head args :: Int
in putStrLn $ intercalate "\n" $ map show $ solve n
data Square = O | X | Qu deriving (Show, Eq)
solve :: (Eq n, Num n) => n -> [Matrix Square]
solve n = nub $ solveN n
where
solveN 1 = solve' [initBoard]
solveN x = solve' (solveN (x-1))
solve' bs = concatMap (\bn -> map ((`placeQueen` bn)) (openPositions bn)) bs
initBoard :: Matrix Square
initBoard = matrix 8 8 (const O)
placeQueen :: (Int, Int) -> Matrix Square -> Matrix Square
placeQueen p b = setElem Qu p $ markAttacks p b
markAttacks :: (Int, Int) -> Matrix Square -> Matrix Square
markAttacks p b = markAll positions b
where markAll [] mb = mb
markAll (mp:mps) mb = let nb = setElem X mp mb
in markAll mps nb
positions = concatMap walk stepDirections
where walk dir = takeWhile inBounds $ iterate (dir) $ dir p
inBounds (i,j) = i >= 1 && i <= nrows b &&
j >= 1 && j <= ncols b
stepDirections =
let a = (+1); s = subtract 1; k = id -- add; subtract; keep
dirF (fr,fc) = (\(r,c) -> (fr r, fc c))
in map dirF [ (a,k), (s,k) -- up, down
, (k,a),(k,s) -- right, left
, (a,a),(a,s),(s,a),(s,s) ] -- diagonals
openPositions :: Matrix Square -> [(Int, Int)]
openPositions b = [(r,c) | r <- [1..8], c <- [1..8], b ! (r,c) == O ]
|
