From 17a1785bbd3efa87995f2e8226aef6763e3c1971 Mon Sep 17 00:00:00 2001 From: Steven Date: Tue, 4 Jun 2019 23:00:01 -0400 Subject: Revert This reverts commit 0f3dad2819eb6664c44e210308e384ccfc1a402a. --- src/Main.hs | 42 +++++++++++++++++------------------------- 1 file changed, 17 insertions(+), 25 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 4d04d06..190e997 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -18,28 +18,20 @@ solve n = nub $ solveN n solveN 1 = solve' [initBoard] solveN x = solve' (solveN (x-1)) solve' bs = concatMap (\bn -> map ((`placeQueen` bn)) (openPositions bn)) bs - -initBoard :: Matrix Square -initBoard = matrix 8 8 (const O) - -placeQueen :: (Int, Int) -> Matrix Square -> Matrix Square -placeQueen p b = setElem Qu p $ markAttacks p b - -markAttacks :: (Int, Int) -> Matrix Square -> Matrix Square -markAttacks p b = markAll positions b - where markAll [] mb = mb - markAll (mp:mps) mb = let nb = setElem X mp mb - in markAll mps nb - positions = concatMap walk stepDirections - where walk dir = takeWhile inBounds $ iterate (dir) $ dir p - inBounds (i,j) = i >= 1 && i <= nrows b && - j >= 1 && j <= ncols b - stepDirections = - let a = (+1); s = subtract 1; k = id -- add; subtract; keep - dirF (fr,fc) = (\(r,c) -> (fr r, fc c)) - in map dirF [ (a,k), (s,k) -- up, down - , (k,a),(k,s) -- right, left - , (a,a),(a,s),(s,a),(s,s) ] -- diagonals - -openPositions :: Matrix Square -> [(Int, Int)] -openPositions b = [(r,c) | r <- [1..8], c <- [1..8], b ! (r,c) == O ] + initBoard = matrix 8 8 (const O) + openPositions b = [(i,j) | i <- [1..8], j <- [1..8], b ! (i,j) == O ] + placeQueen p b = mark Qu p $ markAttacks b + where + markAttacks bo = markAll X positions bo + positions = concatMap 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; nc = id + in [ (a,nc),(s,nc) -- up, down + , (nc,a),(nc,s) -- right, left + , (a,a),(a,s),(s,a),(s,s) ] -- diags + inBounds (i,j) = i >= 1 && i <= nrows b && j >= 1 && j <= ncols b + markAll _ [] mb = mb + markAll x (mp:mps) mb = let nb = mark x mp mb + in markAll x mps nb + mark x mp mb = setElem x mp mb -- cgit v1.2.3