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 antinodes :: (Int,Int) -> (Int,Int) -> (Int,Int) -> [(Int,Int)] antinodes (w,h) (x1,y1) (x2,y2) = [ (x,y) | x <- [0..w-1], y <- [0..h-1], f x y ] where f :: Int -> Int -> Bool f x y = fromIntegral y == m * fromIntegral (x - x1) + fromIntegral y1 m :: Double m = let x1' = fromIntegral x1 x2' = fromIntegral x2 y1' = fromIntegral y1 y2' = fromIntegral y2 in (y2' - y1') / (x2' - x1') 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 doStuff :: Int -> Int -> String -> Int doStuff w h = length . nub . concatMap (concatMap (uncurry (antinodes (w,h))) . 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