summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--8queens.cabal1
-rw-r--r--src/MyQueens.hs59
2 files changed, 60 insertions, 0 deletions
diff --git a/8queens.cabal b/8queens.cabal
index 45f38f8..b2c9788 100644
--- a/8queens.cabal
+++ b/8queens.cabal
@@ -19,6 +19,7 @@ executable 8queens
19 main-is: Main.hs 19 main-is: Main.hs
20 default-language: Haskell2010 20 default-language: Haskell2010
21 build-depends: base >= 4.7 && < 5, 21 build-depends: base >= 4.7 && < 5,
22 rebase,
22 linear, 23 linear,
23 lens, 24 lens,
24 matrix, 25 matrix,
diff --git a/src/MyQueens.hs b/src/MyQueens.hs
new file mode 100644
index 0000000..bc7da02
--- /dev/null
+++ b/src/MyQueens.hs
@@ -0,0 +1,59 @@
1{-# language NoImplicitPrelude #-}
2module MyQueens where
3-- To run, type `stack ghci` then `:load MyQueens` then `main`
4
5import Rebase.Prelude
6
7data Rank = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8
8 deriving (Eq, Enum, Bounded, Show)
9
10data RankOptions = RankOptions [Rank] | RankChoice Rank
11 deriving (Show)
12
13type Board = [RankOptions]
14type PartialBoard = [RankOptions]
15
16allOptionsColumn :: RankOptions
17allOptionsColumn = RankOptions [R1 .. R8]
18
19allOptionsBoard :: Board
20allOptionsBoard = take 8 $ repeat allOptionsColumn
21
22select :: Board -> [Board]
23select (x@(RankChoice _):xs) = map (x:) (select xs)
24select ((RankOptions rs):xs) = dropHopeless $ map (\r -> (RankChoice r):(restrict xs r)) rs
25select [] = error "select on invalid board"
26
27dropHopeless :: [Board] -> [Board]
28dropHopeless = filter (not . any hopeless)
29
30hopeless :: RankOptions -> Bool
31hopeless (RankOptions []) = True
32hopeless _ = False
33
34filterRankOptions :: (Rank -> Bool) -> RankOptions -> RankOptions
35filterRankOptions f (RankOptions rs) = RankOptions (filter f rs)
36filterRankOptions _ x = x
37
38restrict :: PartialBoard -> Rank -> PartialBoard
39restrict rs r =
40 (dropDiagonal pred minBound r) .
41 (dropDiagonal succ maxBound r) .
42 (map (filterRankOptions (/= r))) $
43 rs
44
45dropDiagonal :: (Rank -> Rank) -> Rank -> Rank -> PartialBoard -> PartialBoard
46dropDiagonal _ _ _ [] = []
47dropDiagonal _ bound r x | r == bound = x
48dropDiagonal next bound r (x:xs) = (filterRankOptions (/= next r) x) : dropDiagonal next bound (next r) xs
49
50select' :: [Board] -> [Board]
51select' = concatMap select
52
53queens :: [Board]
54queens = select' . select' . select' . select' . select' . select' . select' . select' $ [allOptionsBoard]
55
56main :: IO ()
57main = do
58 forM_ queens print
59 print $ length queens