diff options
author | Andrew Cady <d@jerkface.net> | 2019-06-14 08:25:34 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-06-14 08:25:34 -0400 |
commit | e46c610d2f7c0c3a4421c30d78752a03b6a61f97 (patch) | |
tree | bc0347c05dd9a492008d1ae2f155cbe8a6c8895c /src | |
parent | cc5dad63219d9951dcc1117ef6cc49b7751ec517 (diff) |
alternative implementation
Diffstat (limited to 'src')
-rw-r--r-- | src/MyQueens.hs | 59 |
1 files changed, 59 insertions, 0 deletions
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 | ||