diff options
-rw-r--r-- | src/Main.hs | 111 |
1 files changed, 27 insertions, 84 deletions
diff --git a/src/Main.hs b/src/Main.hs index 8a593f3..0da1b8f 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -2,97 +2,40 @@ | |||
2 | 2 | ||
3 | module Main where | 3 | module Main where |
4 | 4 | ||
5 | import Control.Lens | ||
6 | import Control.Applicative | ||
7 | import Linear.V2 | ||
8 | import Linear.V3 | ||
9 | import Data.Matrix | ||
10 | import Data.List | 5 | import Data.List |
11 | import qualified Data.Vector as V | 6 | import Data.Matrix |
12 | --import Numeric.LinearAlgebra | 7 | import Data.String |
13 | import System.Random | ||
14 | import Foreign.Storable | ||
15 | import System.IO | ||
16 | import System.Environment | 8 | import System.Environment |
17 | 9 | import System.IO | |
18 | -- Open | Attacked | Queen | ||
19 | data Square = O | X | Qu deriving (Show, Eq) | ||
20 | |||
21 | initBoard = matrix 8 8 $ const O | ||
22 | 10 | ||
23 | main :: IO () | 11 | main :: IO () |
24 | main = do | 12 | main = do |
25 | args <- getArgs | 13 | args <- getArgs |
26 | let n = read $ head args :: Int | 14 | let n = read $ head args :: Int |
27 | in putStrLn $ show $ solve n | 15 | in putStrLn $ intercalate "\n" $ map show $ solve n |
28 | |||
29 | solve :: Int -> [Matrix Square] | ||
30 | solve n | ||
31 | | n < 1 || n > 8 = [] | ||
32 | | otherwise = solveN n | ||
33 | where | ||
34 | place :: [Matrix Square] -> [Matrix Square] | ||
35 | place bs = concat $ map (\b -> map (\p -> placeQueen p b) (openPositions b)) bs | ||
36 | solveN 0 = [] -- ghc thinks I need this; I'm not so sure | ||
37 | solveN 1 = place [initBoard] | ||
38 | solveN n = place (solveN (n-1)) | ||
39 | |||
40 | 16 | ||
41 | queenAllowed p b = all (== O) $ map snd $ getRowColDiag p b | 17 | data Square = O | X | Qu deriving (Show, Eq) |
42 | placeQueen p b = setElem Qu p $ mapQueensPath (\_ _ -> X) p b | ||
43 | |||
44 | allPositions = [(i,j) | i <- [1..8], j <- [1..8]] | ||
45 | scanBoard s b = [(i,j) | (i,j) <- allPositions, (getElem i j b) == s] | ||
46 | |||
47 | openPositions b = scanBoard O b | ||
48 | mapQueensPath :: ((Int,Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a | ||
49 | mapQueensPath f p b = mapRowColDiag f p b | ||
50 | |||
51 | markX p b = setElem X p b | ||
52 | 18 | ||
53 | diag :: (Int,Int) -> Matrix a -> [(Int,Int)] | 19 | solve :: (Eq t, Num t) => t -> [Matrix Square] |
54 | diag c m = apply c | 20 | solve n = solveN n |
55 | where | 21 | where |
56 | ops = (\a b -> [(a,a),(a,b),(b,a),(b,b)]) (+1) (subtract 1) | 22 | solveN 1 = solve [initBoard] |
57 | applyopR (x,y) (fa,fb) = traverse' (\(i,j) -> (fa i, fb j)) (x,y) | 23 | solveN x = solve (solveN (x-1)) |
58 | traverse' dir p = takeWhile inBounds $ iterate dir p | 24 | initBoard = matrix 8 8 (const O) |
59 | inBounds (i,j) = i >= 1 && i <= nrows m && j >= 1 && j <= ncols m | 25 | solve bs = concatMap (\b -> map (\p -> placeQueen p b) (openPositions b)) bs |
60 | apply x = concat $ map (applyopR x) ops | 26 | openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ] |
61 | 27 | placeQueen p b = mark Qu p $ markAttacks b | |
62 | -- did this 2 ways; not sure why I like above better; mostly cuz | 28 | where |
63 | diag' r c = let rl = [1..r] | 29 | markAttacks b = markAll X positions b |
64 | rr = [r..8] | 30 | positions = concat $ map walk directions |
65 | cu = [1..c] | 31 | step (fx,fy) = (\(k,l) -> (fx k, fy l)) |
66 | cd = [c..8] | 32 | walk s = takeWhile inBounds $ iterate (step s) $ step s p |
67 | in zip rl cu ++ zip rr cd ++ | 33 | directions = let a = (+1); s = (subtract 1); n = (id) |
68 | zip (reverse rl) cd ++ zip (reverse rr) cu | 34 | in [ (a,n),(s,n) -- up, down |
69 | 35 | , (n,a),(n,s) -- right, left, diags: | |
70 | 36 | , (a,a),(a,s),(s,a),(s,s) ] | |
71 | -- some of this next shit would've been nice to have already been Data.Matrix | 37 | inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b |
72 | mapRowColDiag :: ((Int,Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a | 38 | markAll x [] b = b |
73 | mapRowColDiag f (r,c) m = | 39 | markAll x (p:ps) b = let nb = mark x p b |
74 | matrix (nrows m) (ncols m) $ \(i,j) -> | 40 | in markAll x ps nb |
75 | let a = unsafeGet i j m | 41 | mark x p b = setElem x p b |
76 | in if i == r || j == c || elem (i,j) ds | ||
77 | then f (i,j) a | ||
78 | else a | ||
79 | where ds = diag (r,c) m | ||
80 | |||
81 | getRowColDiag (r,c) m = map (\(i,j) -> ((i,j), getElem i j m)) $ p | ||
82 | where rows = [(r,j) | j <- [1..(ncols m)]] | ||
83 | cols = [(i,c) | i <- [1..(nrows m)]] | ||
84 | ds = diag (r,c) m | ||
85 | p = nub $ rows ++ cols ++ ds | ||
86 | |||
87 | getRowL r b = map (\x -> b ! (r,x)) [1..8] | ||
88 | getColL c b = map (\x -> b ! (x,c)) [1..8] | ||
89 | getDiagL p b = map (\x -> b ! x) $ diag p b | ||
90 | |||
91 | mapDiag :: ((Int, Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a | ||
92 | mapDiag f p m = | ||
93 | let diags = diag p m | ||
94 | in matrix (nrows m) (ncols m) $ \(i, j) -> | ||
95 | let a = unsafeGet i j m | ||
96 | in if elem (i,j) diags | ||
97 | then f (i, j) a | ||
98 | else a | ||