From e46c610d2f7c0c3a4421c30d78752a03b6a61f97 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 14 Jun 2019 08:25:34 -0400
Subject: alternative implementation

---
 8queens.cabal   |  1 +
 src/MyQueens.hs | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 60 insertions(+)
 create mode 100644 src/MyQueens.hs

diff --git a/8queens.cabal b/8queens.cabal
index 45f38f8..b2c9788 100644
--- a/8queens.cabal
+++ b/8queens.cabal
@@ -19,6 +19,7 @@ executable 8queens
   main-is:             Main.hs
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5,
+                       rebase,
                        linear,
                        lens,
                        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 @@
+{-# 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 (\r -> (RankChoice r):(restrict xs r)) 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 =
+  (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 = select' . select' . select' . select' . select' . select' . select' . select' $ [allOptionsBoard]
+
+main :: IO ()
+main = do
+  forM_ queens print
+  print $ length queens
-- 
cgit v1.2.3