AoC/2023/day11/day11.hs

import Control.Arrow
import Control.Lens
import Data.Function
import Data.Ix
import Data.List
import Data.Ord
import Linear.V2

main :: IO ()
main = interact $ show . (day11 1 &&& day11 999999) . parse . lines

day11 :: V2 Int -> [V2 Int] -> Int
day11 n = (`div` 2) . sum . f . (expandBy n =<< findEmptyRows)
  where
    f xs = [sum $ abs $ x - y | x <- xs, y <- xs]

parse :: [String] -> [V2 Int]
parse =
  map fst .
  filter ((== '#') . snd) . concat . zipWith (map . f) [0 ..] . map (zip [0 ..])
  where
    f x (y, z) = (V2 y x, z)

expandBy :: V2 Int -> [V2 Int] -> [V2 Int] -> [V2 Int]
expandBy _ [] input = input
expandBy n (d:ds) input =
  expandBy n (map (moveCoord n d) ds) (map (moveCoord n d) input)

findEmptyRows :: [V2 Int] -> [V2 Int]
findEmptyRows input =
  map flipV2 (findEmptyRows $ map flipV2 input) ++ findEmptyRows input
  where
    findEmptyRows = deleteFirstsBy ((==) `on` view _x) b
    b = range (V2 0 0, set _y 0 maxP)
    maxP = maximumBy (comparing (view _x)) input
    flipV2 (V2 x y) = V2 y x

moveCoord :: V2 Int -> V2 Int -> V2 Int -> V2 Int
moveCoord n x y =
  if y ^. p >= x ^. p
    then y + n * signum x
    else y
  where
    p =
      if x ^. _x == 0
        then _y
        else _x