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