Files
advent-of-code-2023/day24/Part2.hs
2024-01-01 12:28:01 +01:00

27 lines
2.1 KiB
Haskell

module Part2 where
import Commons
import Math.MFSolve
import Data.Foldable (find)
solve :: [Hailstone] -> Either (DepError SimpleVar Double) (Dependencies SimpleVar Double)
solve [h1, h2, h3, h4, h5, h6] =
let [x0, y0, z0, vx0, vy0, vz0] = map (makeVariable . SimpleVar) ["x0", "y0", "z0", "vx0", "vy0", "vz0"]
in flip execSolver noDeps $
do x0 * fromIntegral (vy h2 - vy h1) + y0 * fromIntegral (vx h1 - vx h2) + vx0 * fromIntegral (y h1 - y h2) + vy0 * fromIntegral (x h2 - x h1) === fromIntegral (y h1 * vx h1 - x h1 * vy h1 + x h2 * vy h2 - y h2 * vx h2)
x0 * fromIntegral (vy h4 - vy h3) + y0 * fromIntegral (vx h3 - vx h4) + vx0 * fromIntegral (y h3 - y h4) + vy0 * fromIntegral (x h4 - x h3) === fromIntegral (y h3 * vx h3 - x h3 * vy h3 + x h4 * vy h4 - y h4 * vx h4)
x0 * fromIntegral (vy h6 - vy h5) + y0 * fromIntegral (vx h5 - vx h6) + vx0 * fromIntegral (y h5 - y h6) + vy0 * fromIntegral (x h6 - x h5) === fromIntegral (y h5 * vx h5 - x h5 * vy h5 + x h6 * vy h6 - y h6 * vx h6)
x0 * fromIntegral (vz h2 - vz h1) + z0 * fromIntegral (vx h1 - vx h2) + vx0 * fromIntegral (z h1 - z h2) + vz0 * fromIntegral (x h2 - x h1) === fromIntegral (z h1 * vx h1 - x h1 * vz h1 + x h2 * vz h2 - z h2 * vx h2)
x0 * fromIntegral (vz h4 - vz h3) + z0 * fromIntegral (vx h3 - vx h4) + vx0 * fromIntegral (z h3 - z h4) + vz0 * fromIntegral (x h4 - x h3) === fromIntegral (z h3 * vx h3 - x h3 * vz h3 + x h4 * vz h4 - z h4 * vx h4)
x0 * fromIntegral (vz h6 - vz h5) + z0 * fromIntegral (vx h5 - vx h6) + vx0 * fromIntegral (z h5 - z h6) + vz0 * fromIntegral (x h6 - x h5) === fromIntegral (z h5 * vx h5 - x h5 * vz h5 + x h6 * vz h6 - z h6 * vx h6)
getCoords :: [Hailstone] -> [Int]
getCoords h = let (h1: h2: h3: h4: h5: h6: _) = h
(Right d) = solve [h1, h2, h3, h4, h5, h6]
vars = knownVars d
(Just x) = find (\ (v, _) -> v == SimpleVar "x0") vars
(Just y) = find (\ (v, _) -> v == SimpleVar "y0") vars
(Just z) = find (\ (v, _) -> v == SimpleVar "z0") vars
in [floor $ snd x, floor $ snd y, floor $ snd z]