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
|
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Data.List
import Data.Matrix
import Data.String
import System.Environment
import System.IO
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 t, Num t) => t -> [Matrix Square]
solve n = solveN n
where
solveN 1 = solve [initBoard]
solveN x = solve (solveN (x-1))
initBoard = matrix 8 8 (const O)
solve bs = concatMap (\b -> map (\p -> placeQueen p b) (openPositions b)) bs
openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ]
placeQueen p b = mark Qu p $ markAttacks b
where
markAttacks b = markAll X positions b
positions = concat $ map walk directions
step (fx,fy) = (\(k,l) -> (fx k, fy l))
walk s = takeWhile inBounds $ iterate (step s) $ step s p
directions = let a = (+1); s = (subtract 1); n = (id)
in [ (a,n),(s,n) -- up, down
, (n,a),(n,s) -- right, left, diags:
, (a,a),(a,s),(s,a),(s,s) ]
inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b
markAll x [] b = b
markAll x (p:ps) b = let nb = mark x p b
in markAll x ps nb
mark x p b = setElem x p b
|