diff options
-rw-r--r-- | src/Main.hs | 32 |
1 files changed, 14 insertions, 18 deletions
diff --git a/src/Main.hs b/src/Main.hs index e6ed4e2..190e997 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -1,12 +1,8 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
3 | module Main where | 1 | module Main where |
4 | 2 | ||
5 | import Data.List | 3 | import Data.List |
6 | import Data.Matrix | 4 | import Data.Matrix |
7 | import Data.String | ||
8 | import System.Environment | 5 | import System.Environment |
9 | import System.IO | ||
10 | 6 | ||
11 | main :: IO () | 7 | main :: IO () |
12 | main = do | 8 | main = do |
@@ -16,26 +12,26 @@ main = do | |||
16 | 12 | ||
17 | data Square = O | X | Qu deriving (Show, Eq) | 13 | data Square = O | X | Qu deriving (Show, Eq) |
18 | 14 | ||
19 | solve :: (Eq t, Num t) => t -> [Matrix Square] | 15 | solve :: (Eq n, Num n) => n -> [Matrix Square] |
20 | solve n = nub $ solveN n | 16 | solve n = nub $ solveN n |
21 | where | 17 | where |
22 | solveN 1 = solve [initBoard] | 18 | solveN 1 = solve' [initBoard] |
23 | solveN x = solve (solveN (x-1)) | 19 | solveN x = solve' (solveN (x-1)) |
20 | solve' bs = concatMap (\bn -> map ((`placeQueen` bn)) (openPositions bn)) bs | ||
24 | initBoard = matrix 8 8 (const O) | 21 | initBoard = matrix 8 8 (const O) |
25 | solve bs = concatMap (\b -> map (\p -> placeQueen p b) (openPositions b)) bs | ||
26 | openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ] | 22 | openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ] |
27 | placeQueen p b = mark Qu p $ markAttacks b | 23 | placeQueen p b = mark Qu p $ markAttacks b |
28 | where | 24 | where |
29 | markAttacks b = markAll X positions b | 25 | markAttacks bo = markAll X positions bo |
30 | positions = concat $ map walk directions | 26 | positions = concatMap walk directions |
31 | step (fx,fy) = (\(k,l) -> (fx k, fy l)) | 27 | step (fx,fy) = (\(k,l) -> (fx k, fy l)) |
32 | walk s = takeWhile inBounds $ iterate (step s) $ step s p | 28 | walk s = takeWhile inBounds $ iterate (step s) $ step s p |
33 | directions = let a = (+1); s = (subtract 1); n = (id) | 29 | directions = let a = (+1); s = subtract 1; nc = id |
34 | in [ (a,n),(s,n) -- up, down | 30 | in [ (a,nc),(s,nc) -- up, down |
35 | , (n,a),(n,s) -- right, left, diags: | 31 | , (nc,a),(nc,s) -- right, left |
36 | , (a,a),(a,s),(s,a),(s,s) ] | 32 | , (a,a),(a,s),(s,a),(s,s) ] -- diags |
37 | inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b | 33 | inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b |
38 | markAll x [] b = b | 34 | markAll _ [] mb = mb |
39 | markAll x (p:ps) b = let nb = mark x p b | 35 | markAll x (mp:mps) mb = let nb = mark x mp mb |
40 | in markAll x ps nb | 36 | in markAll x mps nb |
41 | mark x p b = setElem x p b | 37 | mark x mp mb = setElem x mp mb |