Day eight

day-08-haskell/src/Common.hs

@@ -0,0 +1,37 @@
+module Common where
+
+import Data.Foldable (toList)
+import qualified Data.Map.Strict as Map
+      
+multiMapFromList :: Ord k => [(k, v)] -> Map.Map k [v]
+multiMapFromList = Map.fromListWith (++) . map (\(k, v) -> (k, [v]))
+
+pairPermutations :: [a] -> [(a, a)]
+pairPermutations [] = []
+pairPermutations [_] = []
+pairPermutations [x, y] = pure (x, y)
+pairPermutations (x:xs) = map (\y -> (x, y)) xs ++ pairPermutations xs
+
+type Position = (Int, Int)
+type Antenna = (Char, Position)
+type World = (Position, [Antenna])
+
+enumerate :: [a] -> [(Int, a)]
+enumerate = zip [0..]
+
+readWorld :: String -> World
+readWorld input = (determineSize $ lines input, readAntennas input)
+  where
+    determineSize :: [String] -> Position
+    determineSize ls = (maximum $ map length ls, length ls)
+
+readAntennas :: String -> [Antenna]
+readAntennas input = enumerate (lines input) >>= readLine
+  where
+    readLine :: (Int, String) -> [Antenna]
+    readLine (y, line) = enumerate line >>= toList . readChar
+      where
+        readChar :: (Int, Char) -> Maybe Antenna
+        readChar (_, '.') = Nothing
+        readChar (x, char) = Just (char, (x, y))
+

day-08-haskell/src/Task1.hs

@@ -0,0 +1,28 @@
+module Task1 (task1) where
+
+import Common (Position, readWorld, multiMapFromList, pairPermutations)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Control.Monad (join)
+
+task1 :: String -> Int
+task1 input = case readWorld input of
+  ((width, height), antennas) -> length $ Set.fromList $ filter isInWorld $ join $ map antinodesOfFrequency $ Map.elems $ multiMapFromList antennas
+    where
+      antinodesOfFrequency :: [Position] -> [Position]
+      antinodesOfFrequency nodes = pairPermutations nodes >>= antinodesOfPair
+
+      antinodesOfPair :: (Position, Position) -> [Position]
+      antinodesOfPair ((ax, ay), (bx, by)) =
+        let diffX = bx - ax
+            diffY = by - ay
+        in [(ax - diffX, ay - diffY), (bx + diffX, by + diffY)]
+
+      isInWorld :: Position -> Bool
+      isInWorld (x, y)
+        | x < 0 = False
+        | x >= width = False
+        | y < 0 = False
+        | y >= height = False
+        | otherwise = True
+

day-08-haskell/src/Task2.hs

@@ -0,0 +1,30 @@
+module Task2 (task2) where
+
+import Common (Position, readWorld, multiMapFromList, pairPermutations)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Control.Monad (join)
+
+task2 :: String -> Int
+task2 input = case readWorld input of
+  ((width, height), antennas) -> length $ Set.fromList $ join $ map antinodesOfFrequency $ Map.elems $ multiMapFromList antennas
+    where
+      antinodesOfFrequency :: [Position] -> [Position]
+      antinodesOfFrequency nodes = pairPermutations nodes >>= antinodesOfPair
+
+      antinodesOfPair :: (Position, Position) -> [Position]
+      antinodesOfPair (a@(ax, ay), b@(bx, by)) =
+        let diffX = bx - ax
+            diffY = by - ay
+        in castInWorld a (-diffX, -diffY) ++ castInWorld b (diffX, diffY)
+
+      castInWorld (sx, sy) (ox, oy) =
+        takeWhile isInWorld $ map (\f -> (sx + ox * f, sy + oy * f)) [0..]
+
+      isInWorld :: Position -> Bool
+      isInWorld (x, y)
+        | x < 0 = False
+        | x >= width = False
+        | y < 0 = False
+        | y >= height = False
+        | otherwise = True