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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
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 = solve $ placeQueen n b
where n = 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
-- 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"
|
