From ba07f3549313ad470fe2de9e0cac72556afb8046 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Thu, 30 May 2019 13:06:39 -0400 Subject: ignore .stack-work --- .stack-work/intero/intero265874by-STAGING.hs | 201 --------------------------- 1 file changed, 201 deletions(-) delete mode 100644 .stack-work/intero/intero265874by-STAGING.hs (limited to '.stack-work/intero/intero265874by-STAGING.hs') diff --git a/.stack-work/intero/intero265874by-STAGING.hs b/.stack-work/intero/intero265874by-STAGING.hs deleted file mode 100644 index a82dbd0..0000000 --- a/.stack-work/intero/intero265874by-STAGING.hs +++ /dev/null @@ -1,201 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - -module Main where - -import Control.Lens -import Linear.V2 -import Linear.V3 -import Data.Matrix ---import Numeric.LinearAlgebra -import System.Random -import Foreign.Storable - - -data Square = X -- Attacked - | Qu -- Queen - | O -- Open/available - deriving (Show, Eq) - - ---board = V3 <$> [0..8] <*> [0..8] <*> [0] ---board = [(r,c,X) | r <- [0..8], c <- [0..8] ] - -lo8 = [0..8] -- list of 8 -initBoard = matrix 8 8 $ \_ -> O - -placeQueen (r,c) b = placeQueen' $ markAttacked b - where - placeQueen' b = setElem Qu (r,c) b - markAttacked b = rowAttacked $ colAttacked $ diagAttacked b - fX = (\_ x -> X) - rowAttacked b = mapRow fX r b - colAttacked b = mapCol fX c b - diagAttacked b = let d = diag r c - 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 - -nextAvail b = head [(x,y) | x <- [1..8], y <- [1..8], b ! (x,y) == O] - --- solve b = placeQueen n --- where n = nextAvail b --- next = placeQueen n --- solve' = - --- solve b = --- where solve' b = (\n = placeQueen $ nextAvail b) - -solve b = second - where first = placeQueen (nextAvail b) b - second = placeQueen (nextAvail first) first - -solve' b = s (nA b) b - where s n b = placeQueen n b - nA b = nextAvail b - - ---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] - 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 - -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) - -diag'' c = apply c - where - min = 1 - max = 8 - ops a b = [(a, a), (a, b), (b, a), (b, b)] - allops = ops (+1) (subtract 1) - applyop (x,y) (a,b) = (a x,b y) - applyopr (a,b) (x,y) = traverse' (\(d,f) -> (a d, b f)) (x,y) - traverse' f x = takeWhile (within) $ iterate f x - within (x,y) = let within' z = z >= min && z <= max - in within' x && within' y - applyops ops p = map (\x -> applyopr x p) ops - apply x = concat $ applyops allops x - --- 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 = do - putStrLn "Hi" -- cgit v1.2.3