From 7ac14791ee38965b8b82f761de68c33a2809e7ec Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Fri, 5 Jan 2024 14:10:51 +0000 Subject: [PATCH] Done day 24 --- advent-of-code23.cabal | 5 ++ advent24/Main.hs | 129 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+) create mode 100644 advent24/Main.hs diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal index ff49604..7f69609 100644 --- a/advent-of-code23.cabal +++ b/advent-of-code23.cabal @@ -231,3 +231,8 @@ executable advent23 import: common-extensions, build-directives main-is: advent23/Main.hs build-depends: linear, containers, lens + +executable advent24 + import: common-extensions, build-directives + main-is: advent24/Main.hs + build-depends: linear, text, attoparsec, lens diff --git a/advent24/Main.hs b/advent24/Main.hs new file mode 100644 index 0000000..4e9cc78 --- /dev/null +++ b/advent24/Main.hs @@ -0,0 +1,129 @@ +-- Writeup at https://work.njae.me.uk/2024/01/04/advent-of-code-2023-day-24/ + + +import AoC + +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import Data.Attoparsec.Text hiding (take) +-- import Control.Applicative +import Control.Lens +import Linear +import Data.Maybe +import Data.Ratio +-- import Data.List.Split (chunksOf) + +type Position2 = V2 Rational +type Position3 = V3 Rational + +type Segment = (Position2, Position2) + +data Hailstone = Hailstone { _pos :: V3 Rational, _vel :: V3 Rational } + deriving (Show, Eq, Ord) +makeLenses ''Hailstone + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- TIO.readFile dataFileName + let stones = successfulParse text + print $ part1 stones + print $ part2 stones + +part1, part2 :: [Hailstone] -> Int +part1 stones = length $ filter (uncurry intersects) (pairs bps) + where boundary = (V2 2e14 2e14 , V2 4e14 4e14) -- ((V2 7 7), (V2 27 27)) + bps = catMaybes $ fmap (boundaryPoints boundary) stones + +part2 stones = fromIntegral $ numerator solution `div` denominator solution + where rock = Hailstone (pure 0) (pure 0) -- Hailstone (V3 0 0 0) (V3 0 0 0) + (ay, by) = buildMatrix stones _y + (az, bz) = buildMatrix stones _z + solY = luSolveFinite ay by + solZ = luSolveFinite az bz + rock' = rock & pos . _x .~ (solY ^. _x) + & pos . _y .~ (solY ^. _y) + & pos . _z .~ (solZ ^. _y) + & vel . _x .~ (solY ^. _z) + & vel . _y .~ (solY ^. _w) + & vel . _z .~ (solZ ^. _w) + solution = (rock' ^. pos . _x) + (rock' ^. pos . _y) + (rock' ^. pos . _z) + +intersects :: Segment -> Segment -> Bool +intersects ((V2 x1 y1), (V2 x2 y2)) ((V2 x3 y3), (V2 x4 y4)) = ad && pd + where a = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4) + p = (x1 - x3) * (y1 - y2) - (y1 - y3) * (x1 - x2) + d = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4) + ad = if d < 0 then 0 >= a && a >= d + else 0 <= a && a <= d + pd = if d < 0 then 0 >= p && p >= d + else 0 <= p && p <= d + +boundaryPoints :: (Position2, Position2) -> Hailstone -> Maybe Segment +boundaryPoints b@((V2 minX minY), (V2 maxX maxY)) h + | null ts = Nothing + | tMax < 0 = Nothing + | otherwise = Just (V2 xMin yMin, V2 xMax yMax) + where V2 x y = h ^. pos . _xy + V2 vx vy = h ^. vel . _xy + tMinX = (minX - x) / vx + tMaxX = (maxX - x) / vx + tMinY = (minY - y) / vy + tMaxY = (maxY - y) / vy + ts = filter withinT $ filter (>= 0) [tMinX, tMinY, tMaxX, tMaxY, 0] + tMin = minimum ts + tMax = maximum ts + xMin = x + tMin * vx + xMax = x + tMax * vx + yMin = y + tMin * vy + yMax = y + tMax * vy + withinT t = within b (V2 (x + t * vx) (y + t * vy)) + +within :: (Position2, Position2) -> Position2 -> Bool +within ((V2 minX minY), (V2 maxX maxY)) (V2 x y) = + x >= minX && x <= maxX && y >= minY && y <= maxY + +pairs :: Ord a => [a] -> [(a,a)] +pairs xs = [(x,y) | x <- xs, y <- xs, x < y] + +chunks2 :: [a] -> [(a, a)] +chunks2 [] = [] +chunks2 [_] = [] +chunks2 (x:y:xs) = (x,y) : chunks2 xs + +buildMatrix :: [Hailstone] -> Lens' Position3 Rational -> (M44 Rational, V4 Rational) +buildMatrix hs l = (V4 a1 a2 a3 a4, V4 b1 b2 b3 b4) + where ps = take 4 $ chunks2 hs + [(a1, b1), (a2, b2), (a3, b3), (a4, b4)] = [coeffs p l | p <- ps] + +coeffs :: (Hailstone, Hailstone) -> Lens' Position3 Rational -> (V4 Rational, Rational) +coeffs (h1, h2) l = + (V4 (h2 ^. vel . l - h1 ^. vel . l) + (h1 ^. vel . _x - h2 ^. vel . _x) + (h2 ^. pos . l - h1 ^. pos . l) + (h2 ^. pos . _x - h1 ^. pos . _x) + , h1 ^. pos . l * h1 ^. vel . _x - + h2 ^. pos . l * h2 ^. vel . _x + + h2 ^. pos . _x * h2 ^. vel . l - + h1 ^. pos . _x * h1 ^. vel . l + ) + +-- Parse the input file + +stonesP :: Parser [Hailstone] +stoneP :: Parser Hailstone +vertexP :: Parser (V3 Rational) + +stonesP = stoneP `sepBy` endOfLine +stoneP = Hailstone <$> (vertexP <* symbolP "@") <*> vertexP +vertexP = vecify <$> signed decimal <*> (symbolP "," *> signed decimal) <*> (symbolP "," *> signed decimal) + where vecify x y z = V3 (x % 1) (y % 1) (z % 1) + +symbolP :: Text -> Parser Text +symbolP s = (skipSpace *> string s) <* skipSpace + +successfulParse :: Text -> [Hailstone] +successfulParse input = + case parseOnly stonesP input of + Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right matches -> matches \ No newline at end of file -- 2.34.1