From 640477e80379a7317cc2427188b6acf3591fa74f Mon Sep 17 00:00:00 2001 From: Laura Orvokki Kursula Date: Sun, 8 Dec 2024 13:28:42 +0100 Subject: 8-1 --- 8-1.hs | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) create mode 100644 8-1.hs (limited to '8-1.hs') diff --git a/8-1.hs b/8-1.hs new file mode 100644 index 0000000..d5393e9 --- /dev/null +++ b/8-1.hs @@ -0,0 +1,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 -- cgit v1.2.3