diff --git a/day 8/day_8_sebastian.hs b/day 8/day_8_sebastian.hs new file mode 100644 index 0000000000000000000000000000000000000000..27d35ed6d048b286980d501ab1843f4ec316f0fa --- /dev/null +++ b/day 8/day_8_sebastian.hs @@ -0,0 +1,54 @@ +module Main where + +import Data.Array +import Data.List (transpose) +import qualified Data.Map.Strict as M +import qualified Data.Set as S + +main :: IO () +main = interact solve + +solve :: String -> String +solve s = unlines ["Part 1: " ++ part1 s, "Part 2: " ++ part2 s] + +part1 :: String -> String +part1 s = show (S.size (S.filter (inRange (bounds m)) (getAllAntinodes (getAntennas m)))) where + m = getMap s + +part2 :: String -> String +part2 s = show (S.size (getAllAntinodes' (bounds m) (getAntennas m))) where + m = getMap s + +getMap :: String -> Array (Int, Int) Char +getMap s = listArray ((0, 0), (w - 1, h - 1)) (concat ls) where + ls = transpose (lines s) + w = length (head ls) + h = length ls + +getAntennas :: Array (Int, Int) Char -> M.Map Char (S.Set (Int, Int)) +getAntennas a = foldl addCharToMap M.empty (filter ((/= '.') . snd) (assocs a)) + +addCharToMap :: M.Map Char (S.Set (Int, Int)) -> ((Int, Int), Char) -> M.Map Char (S.Set (Int, Int)) +addCharToMap m (i, c) = M.alter (addPosToSet i) c m + +addPosToSet :: (Int, Int) -> Maybe (S.Set (Int, Int)) -> Maybe (S.Set (Int, Int)) +addPosToSet i Nothing = Just (S.singleton i) +addPosToSet i (Just s) = Just (S.insert i s) + +getAntinodes :: S.Set (Int, Int) -> S.Set (Int, Int) +getAntinodes as = S.map (\((x1, y1), (x2, y2)) -> (2 * x1 - x2, 2 * y1 - y2)) (S.filter (uncurry (/=)) (as `S.cartesianProduct` as)) + +getAllAntinodes :: M.Map Char (S.Set (Int, Int)) -> S.Set (Int, Int) +getAllAntinodes = M.foldl' (\acc antennas -> acc `S.union` getAntinodes antennas) S.empty + +getAllAntinodes' :: ((Int, Int), (Int, Int)) -> M.Map Char (S.Set (Int, Int)) -> S.Set (Int, Int) +getAllAntinodes' bs = M.foldl' (\acc antennas -> acc `S.union` getAntinodes' bs antennas) S.empty + +getAntinodes' :: ((Int, Int), (Int, Int)) -> S.Set (Int, Int) -> S.Set (Int, Int) +getAntinodes' bs as = S.foldl S.union S.empty antinodeSets where + pairs = S.filter (uncurry (/=)) (as `S.cartesianProduct` as) + antinodeSequences = S.map (\((x1, y1), (x2, y2)) -> antinodeSequence (x1, y1) (x2 - x1, y2 - y1)) pairs + antinodeSets = S.map (S.fromList . takeWhile (inRange bs)) antinodeSequences + +antinodeSequence :: (Int, Int) -> (Int, Int) -> [(Int, Int)] +antinodeSequence (x, y) (dx, dy) = (x, y):antinodeSequence (x + dx, y + dy) (dx, dy)