Done day 24

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index ff496043d6779b45c8bf71ed22ac31ee31fbd4cd..7f69609c11958efcb76440d499b14656b77acd63 100644 (file)
--- 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 (file)
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