diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 42 |
1 files changed, 25 insertions, 17 deletions
diff --git a/src/Main.hs b/src/Main.hs index 190e997..4d04d06 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -18,20 +18,28 @@ solve n = nub $ solveN n | |||
18 | solveN 1 = solve' [initBoard] | 18 | solveN 1 = solve' [initBoard] |
19 | solveN x = solve' (solveN (x-1)) | 19 | solveN x = solve' (solveN (x-1)) |
20 | solve' bs = concatMap (\bn -> map ((`placeQueen` bn)) (openPositions bn)) bs | 20 | solve' bs = concatMap (\bn -> map ((`placeQueen` bn)) (openPositions bn)) bs |
21 | initBoard = matrix 8 8 (const O) | 21 | |
22 | openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ] | 22 | initBoard :: Matrix Square |
23 | placeQueen p b = mark Qu p $ markAttacks b | 23 | initBoard = matrix 8 8 (const O) |
24 | where | 24 | |
25 | markAttacks bo = markAll X positions bo | 25 | placeQueen :: (Int, Int) -> Matrix Square -> Matrix Square |
26 | positions = concatMap walk directions | 26 | placeQueen p b = setElem Qu p $ markAttacks p b |
27 | step (fx,fy) = (\(k,l) -> (fx k, fy l)) | 27 | |
28 | walk s = takeWhile inBounds $ iterate (step s) $ step s p | 28 | markAttacks :: (Int, Int) -> Matrix Square -> Matrix Square |
29 | directions = let a = (+1); s = subtract 1; nc = id | 29 | markAttacks p b = markAll positions b |
30 | in [ (a,nc),(s,nc) -- up, down | 30 | where markAll [] mb = mb |
31 | , (nc,a),(nc,s) -- right, left | 31 | markAll (mp:mps) mb = let nb = setElem X mp mb |
32 | , (a,a),(a,s),(s,a),(s,s) ] -- diags | 32 | in markAll mps nb |
33 | inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b | 33 | positions = concatMap walk stepDirections |
34 | markAll _ [] mb = mb | 34 | where walk dir = takeWhile inBounds $ iterate (dir) $ dir p |
35 | markAll x (mp:mps) mb = let nb = mark x mp mb | 35 | inBounds (i,j) = i >= 1 && i <= nrows b && |
36 | in markAll x mps nb | 36 | j >= 1 && j <= ncols b |
37 | mark x mp mb = setElem x mp mb | 37 | stepDirections = |
38 | let a = (+1); s = subtract 1; k = id -- add; subtract; keep | ||
39 | dirF (fr,fc) = (\(r,c) -> (fr r, fc c)) | ||
40 | in map dirF [ (a,k), (s,k) -- up, down | ||
41 | , (k,a),(k,s) -- right, left | ||
42 | , (a,a),(a,s),(s,a),(s,s) ] -- diagonals | ||
43 | |||
44 | openPositions :: Matrix Square -> [(Int, Int)] | ||
45 | openPositions b = [(r,c) | r <- [1..8], c <- [1..8], b ! (r,c) == O ] | ||