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
|
import Data.List (findIndex, find)
import Data.Maybe (isJust, fromJust, isNothing)
import qualified Data.Set as Set
import qualified Data.Array as A
main :: IO ()
main = do
let bd `at` (x, y) = bd A.! (y, x)
let inBounds bd (x, y) =
let (_, (h, w)) = A.bounds bd
in x >= 0 && y >= 0 && x <= w && y <= h
let (x, y) +. (dx, dy) = (x + dx, y + dy)
let rot (dx, dy) = (-dy, dx)
let walk :: A.Array (Int, Int) Char
-> (Int, Int) -> (Int, Int)
-> Set.Set ((Int, Int), (Int, Int))
-> Maybe (Set.Set ((Int, Int), (Int, Int)))
walk bd p dir seen
| not (inBounds bd p) = Just seen
| (p, dir) `Set.member` seen = Nothing
| otherwise =
let p' = p +. dir
in if inBounds bd p' && bd `at` p' == '#'
then walk bd p (rot dir) seen
else walk bd p' dir (Set.insert (p, dir) seen)
bd' <- lines <$> getContents
let Just (Just initx, inity) = find (isJust . fst) (zip (map (findIndex (== '^')) bd') [0..])
let makeBd = A.listArray ((0, 0), (length bd' - 1, length (head bd') - 1)) . concat
let normalPath = Set.toList $ Set.map fst $ fromJust $ walk (makeBd bd') (initx, inity) (0, -1) mempty
print $ length normalPath
let freePositions = normalPath
let makeObsBd (ox, oy) = makeBd $ zipWith fixrow [0..] bd'
where fixrow y row | y == oy = zipWith fix [0..] row
| otherwise = row
fix x c | x == ox = '#'
| otherwise = c
let valid p = p /= (initx, inity) && isNothing (walk (makeObsBd p) (initx, inity) (0, -1) mempty)
print $ length (filter valid freePositions)
|
