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
|
import Data.List (nub)
import Data.Maybe (mapMaybe)
pairs :: [a] -> [(a,a)]
pairs = go []
where
go :: [(a,a)] -> [a] -> [(a,a)]
go res [] = res
go res (x:xs) = go (map (x,) xs ++ res) xs
smul :: (Int,Int) -> Int -> (Int,Int)
smul (p,q) x = (x*p,x*q)
vplus :: (Int,Int) -> (Int,Int) -> (Int,Int)
vplus (p,q) (u,v) = (p+u,q+v)
vminus :: (Int,Int) -> (Int,Int) -> (Int,Int)
vminus (p,q) (u,v) = (p-u,q-v)
antinodes :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
antinodes u v = let p = vminus u v
in vplus v . smul p <$> [-1,2]
separate :: [(Char,(Int,Int))] -> [[(Int,Int)]]
separate = map snd . go []
where
go :: [(Char,[(Int,Int)])]
-> [(Char,(Int,Int))]
-> [(Char,[(Int,Int)])]
go res [] = res
go res (x:xs) = go (f res x) xs
f :: [(Char,[(Int,Int)])]
-> (Char,(Int,Int))
-> [(Char,[(Int,Int)])]
f xs (c,pos) = case lookup c xs of
Nothing -> (c,[pos]) : xs
Just poss -> (c,pos:poss) : rm c xs
rm :: Eq a => a -> [(a,b)] -> [(a,b)]
rm = go []
where
go :: Eq a => [(a,b)] -> a -> [(a,b)] -> [(a,b)]
go res _ [] = res
go res x (a@(p,_):xs) | p == x = go res x xs
| otherwise = go (a:res) x xs
parse :: String -> [(Char,(Int,Int))]
parse s = mapMaybe lift' . flip zip coords . concatMap (map f) . lines $ s
where
f :: Char -> Maybe Char
f '.' = Nothing
f x = Just x
coords :: [(Int,Int)]
coords = let w = length . head $ lines s
h = length $ lines s
in [ (x,y) | x <- [0..w-1], y <- [0..h-1] ]
lift' :: (Maybe a,b) -> Maybe (a,b)
lift' (Just p,q) = Just (p,q)
lift' (Nothing,_) = Nothing
inBounds :: Int -> Int -> (Int,Int) -> Bool
inBounds w h (x,y) = x >= 0 && x < w && y >= 0 && y < h
doStuff :: Int -> Int -> String -> Int
doStuff w h = length
. nub
. concatMap (concatMap (filter (inBounds w h)
. uncurry antinodes)
. pairs)
. separate
. parse
main :: IO ()
main = do
s <- getContents
let ls = lines s
let w = length . head $ ls
let h = length ls
print $ doStuff w h s
|
