2024 Day Eight

DayEight.hs

module DayEight (partOne, partTwo, sampleRadios, mkAntinode, difference, translate, pairs) where

import Data.List (groupBy, sortOn, unfoldr)
import Data.Array (assocs)
import qualified Data.Set as S
import Data.Ix (inRange)
import ArrayHelpers (listTo2dArray)


type Vector = (Int, Int)

difference :: Vector -> Vector -> Vector
difference (r1, c1) (r2, c2) = (r2 - r1, c2 - c1)

translate :: Vector -> Vector -> Vector
translate (r1, c1) (r2, c2) = (r2 + r1, c2 + c1)

sampleRadios :: [String]
sampleRadios = ["............",
                "........0...",
                ".....0......",
                ".......0....",
                "....0.......",
                "......A.....",
                "............",
                "............",
                "........A...",
                ".........A..",
                "............",
                "............"]

pairs :: (Eq a) => [a] -> [(a, a)]
pairs l = [(x,y) | x <- l, y <- l, x /= y]

mkAntinode :: (Vector, Vector) -> Vector
mkAntinode (a,b) = translate b $ difference a b


generateAllAntinodes :: (Vector, Vector) -> [Vector]
generateAllAntinodes (a,b) = iterate (translate delta) b
  where delta = difference a b

partOne :: [String] -> S.Set Vector
partOne inputLines = S.fromList $ concatMap mkAntinodes clusters
  where asArray = listTo2dArray inputLines
        interestingAssocs = [(loc, char) | (loc, char) <- assocs asArray, char /= '.']
        grouped = groupBy sameChar $ sortOn snd interestingAssocs
        sameChar (_, a) (_, b) = a == b
        isInWorld = inRange ((0,0), (length inputLines - 1, length (head inputLines) - 1))
        mkAntinodes locations = filter isInWorld $ map mkAntinode $ pairs locations
        clusters = map (map fst) grouped

partTwo :: [String] -> S.Set Vector
partTwo inputLines = S.fromList $ concatMap mkAntinodes clusters
  where asArray = listTo2dArray inputLines
        interestingAssocs = [(loc, char) | (loc, char) <- assocs asArray, char /= '.']
        grouped = groupBy sameChar $ sortOn snd interestingAssocs
        sameChar (_, a) (_, b) = a == b
        isInWorld = inRange ((0,0), (length inputLines - 1, length (head inputLines) - 1))
        mkAntinodes locations = concatMap generateAllLegalAntinodes $ pairs locations
        generateAllLegalAntinodes (a,b) = takeWhile isInWorld (generateAllAntinodes (a,b))
        clusters = map (map fst) grouped