summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteven <steven.vasilogianis@gmail.com>2019-06-04 21:34:40 -0400
committerSteven <steven.vasilogianis@gmail.com>2019-06-04 21:34:40 -0400
commitfb301042ac6df183bb3c59a2d036844ae5c094d0 (patch)
tree9dfbb713c0da6256482eb94269a241a374dcff61
parent1b1866d0bc0e06eecafb1c46d4ead629a7ae20be (diff)
Removed shadowed bindings & redundant imports
-rw-r--r--src/Main.hs32
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
3module Main where 1module Main where
4 2
5import Data.List 3import Data.List
6import Data.Matrix 4import Data.Matrix
7import Data.String
8import System.Environment 5import System.Environment
9import System.IO
10 6
11main :: IO () 7main :: IO ()
12main = do 8main = do
@@ -16,26 +12,26 @@ main = do
16 12
17data Square = O | X | Qu deriving (Show, Eq) 13data Square = O | X | Qu deriving (Show, Eq)
18 14
19solve :: (Eq t, Num t) => t -> [Matrix Square] 15solve :: (Eq n, Num n) => n -> [Matrix Square]
20solve n = nub $ solveN n 16solve 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