{-# LANGUAGE FlexibleContexts, RecordWildCards, TupleSections, TypeApplications #-}
module Day10 (day10) where
import Data.Bool (bool)
import Data.IntMap (assocs, fromListWith)
import Data.List (sortOn, tails)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (listToMaybe)
import Data.Ord (Down(Down))
import Data.Semigroup (Max(Max), Min(Min), sconcat)
import Data.Set (elems, fromList, member)
import Text.Megaparsec (MonadParsec, between, parseMaybe, sepEndBy)
import Text.Megaparsec.Char (char, newline, space, string)
import Text.Megaparsec.Char.Lexer (decimal, signed)
data Point a = Point {px :: !a, py :: !a, px' :: !a, py' :: !a}
parser :: (Integral a, MonadParsec e String m) => m [Point a]
parser = flip sepEndBy newline $ between (string "position=<") (char '>') $ Point
<$> (space *> signed space decimal)
<*> (char ',' *> space *> signed space decimal)
<*> (string "> velocity=<" *> space *> signed space decimal)
<*> (char ',' *> space *> signed space decimal)
day10 :: String -> Maybe (Int, String)
day10 input = do
points <- parseMaybe @() (parser @Int) input
(t, _) <- listToMaybe $ sortOn (Down @Int . snd) $ assocs $ fromListWith (+) $ (, 1) <$> do
Point {px = x1, py = y1, px' = dx1, py' = dy1}:rest <- tails points
Point {px = x2, py = y2, px' = dx2, py' = dy2} <- rest
[t | dx1 /= dx2, (t, 0) <- [(x1 - x2) `divMod` (dx2 - dx1)]] ++
[t | dy1 /= dy2, (t, 0) <- [(y1 - y2) `divMod` (dy2 - dy1)]]
let results = fromList [(px + px' * t, py + py' * t) | Point {..} <- points]
minMaxXY (x, y) = (Min x, Min y, Max x, Max y)
(Min minX, Min minY, Max maxX, Max maxY) <- sconcat <$> nonEmpty (minMaxXY <$> elems results)
return $ (t,) $ unlines
[[bool '░' '▓' $ (x, y) `member` results | x <- [minX..maxX]] | y <- [minY..maxY]]