summaryrefslogtreecommitdiff
path: root/src/Main.hs
blob: 0da1b8f5effcbab3429b2beb798cc5f42941eaa2 (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
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