diff options
-rw-r--r-- | 8queens.cabal | 1 | ||||
-rw-r--r-- | src/MyQueens.hs | 59 |
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 #-} | ||
2 | module MyQueens where | ||
3 | -- To run, type `stack ghci` then `:load MyQueens` then `main` | ||
4 | |||
5 | import Rebase.Prelude | ||
6 | |||
7 | data Rank = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | ||
8 | deriving (Eq, Enum, Bounded, Show) | ||
9 | |||
10 | data RankOptions = RankOptions [Rank] | RankChoice Rank | ||
11 | deriving (Show) | ||
12 | |||
13 | type Board = [RankOptions] | ||
14 | type PartialBoard = [RankOptions] | ||
15 | |||
16 | allOptionsColumn :: RankOptions | ||
17 | allOptionsColumn = RankOptions [R1 .. R8] | ||
18 | |||
19 | allOptionsBoard :: Board | ||
20 | allOptionsBoard = take 8 $ repeat allOptionsColumn | ||
21 | |||
22 | select :: Board -> [Board] | ||
23 | select (x@(RankChoice _):xs) = map (x:) (select xs) | ||
24 | select ((RankOptions rs):xs) = dropHopeless $ map (\r -> (RankChoice r):(restrict xs r)) rs | ||
25 | select [] = error "select on invalid board" | ||
26 | |||
27 | dropHopeless :: [Board] -> [Board] | ||
28 | dropHopeless = filter (not . any hopeless) | ||
29 | |||
30 | hopeless :: RankOptions -> Bool | ||
31 | hopeless (RankOptions []) = True | ||
32 | hopeless _ = False | ||
33 | |||
34 | filterRankOptions :: (Rank -> Bool) -> RankOptions -> RankOptions | ||
35 | filterRankOptions f (RankOptions rs) = RankOptions (filter f rs) | ||
36 | filterRankOptions _ x = x | ||
37 | |||
38 | restrict :: PartialBoard -> Rank -> PartialBoard | ||
39 | restrict rs r = | ||
40 | (dropDiagonal pred minBound r) . | ||
41 | (dropDiagonal succ maxBound r) . | ||
42 | (map (filterRankOptions (/= r))) $ | ||
43 | rs | ||
44 | |||
45 | dropDiagonal :: (Rank -> Rank) -> Rank -> Rank -> PartialBoard -> PartialBoard | ||
46 | dropDiagonal _ _ _ [] = [] | ||
47 | dropDiagonal _ bound r x | r == bound = x | ||
48 | dropDiagonal next bound r (x:xs) = (filterRankOptions (/= next r) x) : dropDiagonal next bound (next r) xs | ||
49 | |||
50 | select' :: [Board] -> [Board] | ||
51 | select' = concatMap select | ||
52 | |||
53 | queens :: [Board] | ||
54 | queens = select' . select' . select' . select' . select' . select' . select' . select' $ [allOptionsBoard] | ||
55 | |||
56 | main :: IO () | ||
57 | main = do | ||
58 | forM_ queens print | ||
59 | print $ length queens | ||