summaryrefslogtreecommitdiff
path: root/src/Main.hs
blob: 190e997eab4494b6cc4bb81fab4fb1e40dbba5aa (plain)
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
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 8 8 (const O)
    openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ]
    placeQueen p b = mark Qu p $ markAttacks b
      where
        markAttacks bo = markAll X positions bo
        positions = concatMap 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; nc = id
                     in [   (a,nc),(s,nc)             -- up, down
                          , (nc,a),(nc,s)             -- right, left
                          , (a,a),(a,s),(s,a),(s,s) ] -- diags
        inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b
        markAll _ [] mb = mb
        markAll x (mp:mps) mb = let nb = mark x mp mb
                             in markAll x mps nb
        mark x mp mb = setElem x mp mb