Cleaned up

1 files changed, 41 insertions, 300 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 5a66878..8a593f3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,226 +13,80 @@ import qualified Data.Vector as V
 import System.Random
 import Foreign.Storable
 import System.IO
+import System.Environment
 
 -- Open | Attacked | Queen
 data Square = O | X | Qu deriving (Show, Eq)
 
 initBoard = matrix 8 8 $ const O
 
-placeQueen' (r,c) b = placeQueen' $ markAttacked b
-  where
-    placeQueen' b = setElem Qu (r,c) b
-    markAttacked b = rowAttacked $ colAttacked b -- $ diagAttacked b
-    fX = (\_ x -> X)
-    rowAttacked b = mapRow fX r b
-    colAttacked b = mapCol fX c b
-    -- diagAttacked b = let d = diag (r,c) b
-    --                      attack ap ab  = setElem X ap ab
-    --                      attackall [x] = attack x b
-    --                      attackall (x:xs) = attack x (attackall xs)
-    --                  in attackall d
---                     in last $ map (\p -> setElem X p b) d
---                     in last $ scanr (\p -> setElem X p) b
-
---solve b = placeQueen (nextAvail b) b
-
-queenAllowed p b = all (== O) $ map snd $ getRowColDiag p b
-
-placeQueen p b = setElem Qu p $ mapQueensPath (\_ _ -> X) p b
-
-mapRowColDiag :: ((Int,Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a
-mapRowColDiag f (r,c) m =
-  matrix (nrows m) (ncols m) $ \(i,j) ->
-    let a = unsafeGet i j m
-    in  if i == r || j == c || elem (i,j) ds
-          then f (i,j) a
-        else a
-  where ds = diag (r,c) m
-
-getRowColDiag (r,c) m = map (\(i,j) -> ((i,j), getElem i j m)) $ p
-  where rows = [(r,j) | j <- [1..(ncols m)]]
-        cols = [(i,c) | i <- [1..(nrows m)]]
-        ds = diag (r,c) m
-        p = nub $ rows ++ cols ++ ds
-
-mapQueensPath :: ((Int,Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a
-mapQueensPath f p b = mapRowColDiag f p b
-
-allPositions = [(i,j) | i <- [1..8], j <- [1..8]]
-
-scanBoard s b = [(i,j) | (i,j) <- allPositions, (getElem i j b) == s]
-
-openPositions b = scanBoard O b
---mapOpenPositions f b = map f $ openPositions b
-
-nextAvail b = head $ takeWhile (\x -> queenAllowed x b) $ openPositions b
-
-getRowL r b = map (\x -> b ! (r,x)) [1..8]
-getColL c b = map (\x -> b ! (x,c)) [1..8]
-getDiagL p b = map (\x -> b ! x) $ diag p b
-
-
-isWinnable n b = n <= rowsAvail && n <= colsAvail
-  where availOn axisF =
-          maximum $ map (length) $
-          map (filter (== O)) $
-          map (\x -> axisF x b) [1..8]
-        rowsAvail = availOn getRowL
-        colsAvail = availOn getColL
-
-isWinnable' n b = "rs: " ++ show rowsAvail  ++ " | cs: " ++ show colsAvail
-  where availOn axisF =
-          maximum $ map (length) $
-          map (filter (== O)) $
-          map (\x -> axisF x b) [1..8]
-        rowsAvail = availOn getRowL
-        colsAvail = availOn getColL
-        -- calc free rows, free cols vs remaining queens
-
-w = winners' 1 initBoard
-
-
-
-
--- solve n = tryAll n initBoard
---   where tryAll 1 b = safePos 0 b
---         tryall n b = safePos n $ tryAll (n-1) b
---         safePos n b = map (\x -> placeQueen x b) $
---                     filter (\x -> queenAllowed x b && isWinnable n b) $ openPositions b
-
--- WAS HERE
--- solve n = winners n [initBoard]
---   where
---     winners 1 b = concat $ map (winners' 1) b
---     winners n b = winners (n-1) $ concat  $ map (winners' (n-1)) b
---     winners' n ab = map (\x -> placeQueen x ab) $
---                   filter (\x -> queenAllowed x ab && isWinnable n ab) $
---                   openPositions ab
-
+main :: IO ()
+main = do
+  args <- getArgs
+  let n = read $ head args :: Int
+    in putStrLn $ show $ solve n
 
+solve :: Int -> [Matrix Square]
 solve n
   | n < 1 || n > 8 = []
   | otherwise = solveN n
   where
     place :: [Matrix Square] -> [Matrix Square]
     place bs = concat $ map (\b -> map (\p -> placeQueen p b) (openPositions b)) bs
-    --         map (\b -> map (\p -> placeQueen p b) (openPositions b)) [initBoard]
-    solveN 0 = []
+    solveN 0 = []               -- ghc thinks I need this; I'm not so sure
     solveN 1 = place [initBoard]
     solveN n = place (solveN (n-1))
 
 
---    solveN n = place (solveN (n-1))
-
---        solveN n f = map place f
-        -- solveN n = place (solveN (n-1))
-        -- applyN 1 f = f
-        -- applyN n f = f (applyN (n-1) f)
-
-
-winners 1 b = concat $ map (winners' 1) b
-winners n b = winners (n-1) $ concat $ map (winners' n) b
-winners' n ab = map (\x -> placeQueen x ab) $
-                filter (\x -> queenAllowed x ab) $
-                openPositions ab
-
-
---s b = map (\y -> placeQueen y b) $ filter (\x -> queenAllowed x b) $ openPositions b
-s b = map (\y -> placeQueen y b) $ filter (\x -> queenAllowed x b) $ openPositions b
- 
-
--- solve n = times n tryAll n initBoard
---   where
---     times 0 b _ = print "Solution: \n" ++ show b
---     times 1 b p = b
---     times x b p = let nb = b
---                   in times (x-1) $ tryAll x nb
---     allPositions b = map (\x -> placeQueen x b) $ openPositions b
---     tryAll n b = filter (\x -> queenAllowed x b && isWinnable n b) $ allPositions
-
-
--- solve n = times n $ exhaust n initBoard
---   where exhaust n b = filter lookAhead $ map (\x -> placeQueen x b) $ openPositions b
---         lookAhead b stillNeed = isWinnable stillNeeded b 
---         times 1 b p = b
---         times x b p = let nb = b
---                       in times (x-1) $ exhaust (x-1) b
-
-
--- solve n = times n $ placeQueen (nextAvail initBoard) initBoard
---     tryAll n b = let a = isWinnable placeQueen n b
---                  in if a then a else tryAt (n+1) b
---     times 1 b p = b
---     times x b p = let nb = b
---                   in times (x-1) $ placeQueen (nextAvail nb) nb
-
-
--- solve' n = times n $ placeQueen (nextAvail initBoard) initBoard
---   where
--- --    with x = 
--- --    place' 0 b = b
--- --    place' n b = placeQueen (nextAvail b) $ place' (n-1)
--- --    place n b = placeQueen (nextAvail b) $ place
---     -- place' n b = place (n-1) $ placeQueen (nextAvail initBoard) initBoard
---     -- place n = place' (n-1) $ placeQueen (nextAvail initBoard) initBoard
---     nextFunc 1 = nextAvail
---     nextFunc x = nextAvail $ nextFunc (x-1)
---     times 1 b = b
---     times x b = let nb = b
---                     na = nextAvail nb
---                 in times (x-1) $ placeQueen (na) nb
-
-
-    -- times 0 f p b = undefined
-    -- times x f p b = times (x-1) $ f p b
-
-    -- place n r = place (n-1) $ place' n r
-    -- place 0 r = r
-    -- place' n r = placeQueen (nextAvail r) r
-
-
--- togglePosition :: (Int,Int) -> f -> t -> Matrix a -> Matrix a
--- togglePosition p b = 
+queenAllowed p b = all (== O) $ map snd $ getRowColDiag p b
+placeQueen p b = setElem Qu p $ mapQueensPath (\_ _ -> X) p b
 
--- solve b = placeQueen n
---   where n = nextAvail b
---         next = placeQueen n
---         solve' =
+allPositions = [(i,j) | i <- [1..8], j <- [1..8]]
+scanBoard s b = [(i,j) | (i,j) <- allPositions, (getElem i j b) == s]
 
--- solve b =
---   where solve' b = (\n = placeQueen $ nextAvail b)
+openPositions b = scanBoard O b
+mapQueensPath :: ((Int,Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a
+mapQueensPath f p b = mapRowColDiag f p b
 
--- solve b = second
---   where first = placeQueen (nextAvail b) b
---         second = placeQueen (nextAvail first) first
+markX p b = setElem X p b
 
--- solve' b = s (nA b) b
---   where s n b = placeQueen n b
---         nA b = nextAvail b
 diag :: (Int,Int) -> Matrix a -> [(Int,Int)]
 diag c m = apply c
   where
     ops = (\a b -> [(a,a),(a,b),(b,a),(b,b)]) (+1) (subtract 1)
-    -- applyop (x,y) (a,b)  = (a x,b y)
     applyopR (x,y) (fa,fb) = traverse' (\(i,j) -> (fa i, fb j)) (x,y)
     traverse' dir p = takeWhile inBounds $ iterate dir p
     inBounds (i,j) = i >= 1 && i <= nrows m && j >= 1 && j <= ncols m
---    applyops p = map ((`applyopR` p)) ops
---    apply x = concat $ map (applyopR x) $ applyops x
     apply x = concat $ map (applyopR x) ops
 
---diag r c = [(x,y) | x <- [1..8], y <- [1..8], (abs x-y) == 1 ]
-diag'' r c = let rl = [1..r]
-                 rr = [r..8]
-                 cu = [1..c]
-                 cd = [c..8]
+-- did this 2 ways; not sure why I like above better; mostly cuz
+diag' r c = let rl = [1..r]
+                rr = [r..8]
+                cu = [1..c]
+                cd = [c..8]
              in zip rl cu ++ zip rr cd ++
                 zip (reverse rl) cd ++ zip (reverse rr) cu
 
-allops a b = [(a, a), (a, b), (b, a), (b, b)]
-ops = allops (+1) (subtract 1)
-applyop (x,y) (a,b)  = (a x,b y)
-applyops p = map (applyop p) ops
+
+-- some of this next shit would've been nice to have already been Data.Matrix 
+mapRowColDiag :: ((Int,Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a
+mapRowColDiag f (r,c) m =
+  matrix (nrows m) (ncols m) $ \(i,j) ->
+    let a = unsafeGet i j m
+    in  if i == r || j == c || elem (i,j) ds
+          then f (i,j) a
+        else a
+  where ds = diag (r,c) m
+
+getRowColDiag (r,c) m = map (\(i,j) -> ((i,j), getElem i j m)) $ p
+  where rows = [(r,j) | j <- [1..(ncols m)]]
+        cols = [(i,c) | i <- [1..(nrows m)]]
+        ds = diag (r,c) m
+        p = nub $ rows ++ cols ++ ds
+
+getRowL r b = map (\x -> b ! (r,x)) [1..8]
+getColL c b = map (\x -> b ! (x,c)) [1..8]
+getDiagL p b = map (\x -> b ! x) $ diag p b
 
 mapDiag :: ((Int, Int) -> a -> a) -> (Int,Int) -> Matrix a -> Matrix a
 mapDiag f p m =
@@ -242,116 +96,3 @@ mapDiag f p m =
          in if elem (i,j) diags
               then f (i, j) a
               else a
-
-
--- mapDiag f c b = map (\(x,y) -> setElem f (x,y) b) ds
---   where ds = diag'' c
-
--- mapDiag' f c b = map (on b f) ds where ds = diag'' c on b x p = let next bo =
---    set x p bo in map (next) b set x p b = setElem x p b
-
---mapDiag'' f c b = take 10 $ iterate (map (set f) ds) b
--- mapDiag'' f c b = take 10 $ iterate (
---    where ds = diag'' c
---          eachD' p = setElem f p
---          eachD [p] = eachD' p
---          eachD (p:ps) = eachD' p : eachD ps
-
-markX p b = setElem X p b
-
--- mapDiag'' f p b = applyfs fs b
---    where ds = diag'' p
---          fs = map (\x y -> markX x y) ds
---          applyfs [x] b = x b
---          applyfs (x:xs) b = applyfs x (applyfs xs)
-
-
-onBoard b f = let next n = f n
-              in next b
-
---eB = mapDiag''' (\_ -> 1) (5,5) $ matrix 8 8 (\_ -> 0)
-
-
---        opfs ops = map (\(o1,o2) -> (\(x,y) -> (o1 x, o2 y))) ops
---        applyops x = map x  opfs
---        ops = map (
-        --applyops (x,y) = map (($ x), ($ y)) $ allops (+1) (-1)
---        fx a b = map \((oa,ob) -> ((cx,cy) -> (oa cx, ob cy))) $ allops (+1) (-1)
-        --applyops x = [(((fst f) (fst x)), ((snd f) (snd x))) | f <- allops (+1) (-1)]
---        applyops x = (fst x, snd x)
---        applyops x = map \((p,m) -> (p (fst x), m (snd x))) $ allops (+1) (-1)
---        apply c = map (\(p,m) -> (p (fst c), m (snd c))) $ allops (+1) (-1)
---        apply ops c = [( (fst o) (fst c), (snd o) (snd c) | o <- ops
-
-
-
--- diag (r,c) b =
---   where l = (r-1,c-1)
---         r = (r+1,c+1)
---         lowbound = 1
---         highbound = 8
-
-
---initBoard = (8><8) $ repeat O
-
---firstOpen b = take 1 [(r,c)| r <- [1..8], c <- [1..8], b ! (r,c) == O]
-
--- firstOpen b = let 
---                 elem x y = b ! (x, y)
---             in map 
-
--- nextOpen b = 
-
--- solve = let board = initBoard
-
---avail r c b =
-
---rowOccupied r b = any (== Q) $ getRow r b
-
-
-
--- diags p = let r = r p
---               l = l p
---           in p : inRange r
---   where inRange x = x >= 1 && x <= 8
---         inRange' (x,y) = inRange (x) && inRange (y)
---         r x = (fst x + 1, snd x + 1)
---         l x = (fst x - 1, snd x - 1)
---         nexts x = diags' x
---         diags' x = [(fst x - 1, snd x -1), (fst x + 1, snd x + 1)]
---         -- down x = (fst x - 1, snd x - 1)
---         -- down (r,c) = let d = (r-1,c-1) in if inRange d then d : down d else 
---         -- up (r,c) = let u = (r+1,c+1) in u : up u
-
-
---mapDiag r c = undefined
-
---placeAll = repeat 8 placeQueen
-
-winnable = undefined
-
-nextOpen board = undefined
-
--- placeQueen r c =
-
---b = getE
-
---placeQueen r c b = b ^.
-
--- rand = do
---   g <- newStdGen
---   print $ take 8 $ (randomRs (0, 8) g)
-
-
--- try r c = let next b = placeQueen r c b
---           in next initBoard
-
--- try' p = let next b = p b
---           in next initBoard
-
-
---res = [ try x y | x <- lo8, y <- lo8 ]
-
-main :: IO ()
-main =
-  putStrLn "Hi"