diff options
| -rw-r--r-- | 8-2.hs | 78 |
1 files changed, 78 insertions, 0 deletions
@@ -0,0 +1,78 @@ +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 |