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
|
import Control.Monad.State
import Control.Parallel
import Control.Parallel.Strategies
import Data.List ((\\), intersperse, nub)
type Map = [[Tile]]
data Tile = Free | Obstacle deriving (Eq, Show)
data Coords = Coords Int Int deriving (Eq, Show)
type Vel = Coords
width, height :: [[a]] -> Int
width = length . head
height = length
map2 :: (a -> b) -> [[a]] -> [[b]]
map2 = map . map
showMap :: Map -> String
showMap = unlines . map2 f
where
f :: Tile -> Char
f Free = '.'
f Obstacle = '#'
sub :: Map -> Coords -> Tile
sub m c@(Coords x y)
| outOfBounds m c = Free
| otherwise = m !! y !! x
parseLines :: [[Char]] -> Map
parseLines =
let p c = case c of
'#' -> Obstacle
_ -> Free
in map2 p
startingPosition :: [[Char]] -> Coords
startingPosition = head . coords . map2 (== '^')
where
coords :: [[Bool]] -> [Coords]
coords xs = [ Coords x y | x <- [0 .. width xs - 1]
, y <- [0 .. height xs - 1]
, xs !! y !! x
]
move :: Vel -> Coords -> Coords
move (Coords vx vy) (Coords px py) = Coords (px + vx) (py + vy)
checkAhead :: Map -> Vel -> Coords -> Bool
checkAhead m = (((== Free) . sub m) .) . move
turn :: Vel -> Coords -> (Coords, Vel)
turn v p =
let rot (Coords x y) = Coords (-y) x
v' = rot v
in (p, v')
step :: Map -> Vel -> Coords -> (Coords, Vel)
step m v p = if checkAhead m v p
then (move v p, v)
else turn v p
outOfBounds :: Map -> Coords -> Bool
outOfBounds m (Coords x y) = x < 0 || x >= w || y < 0 || y >= h
where
w = width m
h = height m
-- return true if loop
run :: Map -> Vel -> Coords -> State [(Coords,Vel)] Bool
run m v p = do
if outOfBounds m p
then return False
else do
t <- get
if (p,v) `elem` t
then return True
else do
modify ((p,v):)
let (p', v') = step m v p
in run m v' p'
block :: Map -> (Int, Int) -> Map
block m (x,y) =
[
[ if (x',y') == (x,y)
then Obstacle
else sub m (Coords x' y')
| x' <- [0 .. width m - 1] ]
| y' <- [0 .. height m - 1]
]
possibilities :: Map -> [Coords]-> [Map]
possibilities m cs =
let coords = map (\ (Coords x y) -> (x,y)) cs
in coords `pseq` (map (block m) coords `using` parList rseq)
main :: IO ()
main = do
ls <- lines <$> getContents
let m = parseLines ls
let p = startingPosition ls
let v = Coords 0 (-1)
let path = map fst $ execState (run m v p) []
let ms = possibilities m $ nub path
let res = ms `pseq` (map (\ n -> evalState (run n v p) []) ms `using` parList rdeepseq)
print . length . filter id $ res
|
