summaryrefslogtreecommitdiff
path: root/.stack-work/intero/intero265874by-STAGING.hs
diff options
context:
space:
mode:
Diffstat (limited to '.stack-work/intero/intero265874by-STAGING.hs')
-rw-r--r--.stack-work/intero/intero265874by-STAGING.hs201
1 files changed, 0 insertions, 201 deletions
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 @@
1{-# LANGUAGE FlexibleContexts #-}
2
3module Main where
4
5import Control.Lens
6import Linear.V2
7import Linear.V3
8import Data.Matrix
9--import Numeric.LinearAlgebra
10import System.Random
11import Foreign.Storable
12
13
14data Square = X -- Attacked
15 | Qu -- Queen
16 | O -- Open/available
17 deriving (Show, Eq)
18
19
20--board = V3 <$> [0..8] <*> [0..8] <*> [0]
21--board = [(r,c,X) | r <- [0..8], c <- [0..8] ]
22
23lo8 = [0..8] -- list of 8
24initBoard = matrix 8 8 $ \_ -> O
25
26placeQueen (r,c) b = placeQueen' $ markAttacked b
27 where
28 placeQueen' b = setElem Qu (r,c) b
29 markAttacked b = rowAttacked $ colAttacked $ diagAttacked b
30 fX = (\_ x -> X)
31 rowAttacked b = mapRow fX r b
32 colAttacked b = mapCol fX c b
33 diagAttacked b = let d = diag r c
34 attack ap ab = setElem X ap ab
35 attackall [x] = attack x b
36 attackall (x:xs) = attack x (attackall xs)
37 in attackall d
38-- in last $ map (\p -> setElem X p b) d
39-- in last $ scanr (\p -> setElem X p) b
40
41--solve b = placeQueen (nextAvail b) b
42
43nextAvail b = head [(x,y) | x <- [1..8], y <- [1..8], b ! (x,y) == O]
44
45-- solve b = placeQueen n
46-- where n = nextAvail b
47-- next = placeQueen n
48-- solve' =
49
50-- solve b =
51-- where solve' b = (\n = placeQueen $ nextAvail b)
52
53solve b = second
54 where first = placeQueen (nextAvail b) b
55 second = placeQueen (nextAvail first) first
56
57solve' b = s (nA b) b
58 where s n b = placeQueen n b
59 nA b = nextAvail b
60
61
62--diag r c = [(x,y) | x <- [1..8], y <- [1..8], (abs x-y) == 1 ]
63diag r c = let rl = [1..r]
64 rr = [r..8]
65 cu = [1..c]
66 cd = [c..8]
67 in zip rl cu ++ zip rr cd ++
68 zip (reverse rl) cd ++ zip (reverse rr) cu
69
70allops a b = [(a, a), (a, b), (b, a), (b, b)]
71ops = allops (+1) (subtract 1)
72applyop (x,y) (a,b) = (a x,b y)
73applyops p = map (applyop p) ops
74
75mapDiag f c b = map (\(x,y) -> setElem f (x,y) b) ds
76 where ds = diag'' c
77
78mapDiag' f c b = map (on b f) ds
79 where ds = diag'' c
80 on b x p = let next bo = set x p bo
81 in map (next) b
82 set x p b = setElem x p b
83
84--mapDiag'' f c b = take 10 $ iterate (map (set f) ds) b
85-- mapDiag'' f c b = take 10 $ iterate (
86-- where ds = diag'' c
87-- eachD' p = setElem f p
88-- eachD [p] = eachD' p
89-- eachD (p:ps) = eachD' p : eachD ps
90
91markX p b = setElem X p b
92
93mapDiag''' f p b = applyfs fs b
94 where ds = diag'' p
95 fs = map (\x y -> markX x y) ds
96 applyfs [x] b = x b
97 applyfs (x:xs) b = applyfs x (applyfs xs)
98
99
100onBoard b f = let next n = f n
101 in next b
102
103--eB = mapDiag''' (\_ -> 1) (5,5) $ matrix 8 8 (\_ -> 0)
104
105diag'' c = apply c
106 where
107 min = 1
108 max = 8
109 ops a b = [(a, a), (a, b), (b, a), (b, b)]
110 allops = ops (+1) (subtract 1)
111 applyop (x,y) (a,b) = (a x,b y)
112 applyopr (a,b) (x,y) = traverse' (\(d,f) -> (a d, b f)) (x,y)
113 traverse' f x = takeWhile (within) $ iterate f x
114 within (x,y) = let within' z = z >= min && z <= max
115 in within' x && within' y
116 applyops ops p = map (\x -> applyopr x p) ops
117 apply x = concat $ applyops allops x
118
119-- opfs ops = map (\(o1,o2) -> (\(x,y) -> (o1 x, o2 y))) ops
120-- applyops x = map x opfs
121-- ops = map (
122 --applyops (x,y) = map (($ x), ($ y)) $ allops (+1) (-1)
123-- fx a b = map \((oa,ob) -> ((cx,cy) -> (oa cx, ob cy))) $ allops (+1) (-1)
124 --applyops x = [(((fst f) (fst x)), ((snd f) (snd x))) | f <- allops (+1) (-1)]
125-- applyops x = (fst x, snd x)
126-- applyops x = map \((p,m) -> (p (fst x), m (snd x))) $ allops (+1) (-1)
127-- apply c = map (\(p,m) -> (p (fst c), m (snd c))) $ allops (+1) (-1)
128-- apply ops c = [( (fst o) (fst c), (snd o) (snd c) | o <- ops
129
130
131
132-- diag (r,c) b =
133-- where l = (r-1,c-1)
134-- r = (r+1,c+1)
135-- lowbound = 1
136-- highbound = 8
137
138
139--initBoard = (8><8) $ repeat O
140
141--firstOpen b = take 1 [(r,c)| r <- [1..8], c <- [1..8], b ! (r,c) == O]
142
143-- firstOpen b = let
144-- elem x y = b ! (x, y)
145-- in map
146
147-- nextOpen b =
148
149-- solve = let board = initBoard
150
151--avail r c b =
152
153--rowOccupied r b = any (== Q) $ getRow r b
154
155
156
157-- diags p = let r = r p
158-- l = l p
159-- in p : inRange r
160-- where inRange x = x >= 1 && x <= 8
161-- inRange' (x,y) = inRange (x) && inRange (y)
162-- r x = (fst x + 1, snd x + 1)
163-- l x = (fst x - 1, snd x - 1)
164-- nexts x = diags' x
165-- diags' x = [(fst x - 1, snd x -1), (fst x + 1, snd x + 1)]
166-- -- down x = (fst x - 1, snd x - 1)
167-- -- down (r,c) = let d = (r-1,c-1) in if inRange d then d : down d else
168-- -- up (r,c) = let u = (r+1,c+1) in u : up u
169
170
171--mapDiag r c = undefined
172
173--placeAll = repeat 8 placeQueen
174
175winnable = undefined
176
177nextOpen board = undefined
178
179-- placeQueen r c =
180
181--b = getE
182
183--placeQueen r c b = b ^.
184
185-- rand = do
186-- g <- newStdGen
187-- print $ take 8 $ (randomRs (0, 8) g)
188
189
190-- try r c = let next b = placeQueen r c b
191-- in next initBoard
192
193-- try' p = let next b = p b
194-- in next initBoard
195
196
197--res = [ try x y | x <- lo8, y <- lo8 ]
198
199main :: IO ()
200main = do
201 putStrLn "Hi"