Day 24: Never Tell Me The Odds

The unknowns we need are px, py, pz, vx, vy, vz, t, s, and r; where t, s, and r are the 3 times of intersection.

So we can determine these by:

• px1 + vx1 * t = px + vx * t
• py1 + vy1 * t = py + vy * t
• pz1 + vz1 * t = pz + vz * t
• px2 + vx2 * s = px + vx * s
• py2 + vy2 * s = py + vy * s
• pz2 + vz2 * s = pz + vz * s
• px3 + vx3 * r = px + vx * r
• py3 + vy3 * r = py + vy * r
• pz3 + vz3 * r = pz + vz * r

Where px1, py1, pz1, vx1, vy1, vz1, etc, are the positions & velocities of the first three points on our list.

(Except we get trolled in the test input and the system is under-determined in the first 3 so we have to look a bit later. TBH I didn't consider this when attempting to solve with numpy, and this might be why I got the wrong answer for the test input, maybe it would've worked if I tried 3 different points. But I don't want to go back and try again.)

module Main (main) where
import AOCTools (splitOn, splitBy)
import Data.Ratio ((%), numerator)
import Data.Maybe (fromJust, catMaybes, mapMaybe)

lowerBound = 200000000000000
upperBound = 400000000000000

main :: IO ()
main = do
    input <- readFile "./input.txt"
    putStrLn $ "Part 1: " ++ show (solve1 $ parseInput input)
    putStrLn $ "Part 2: " ++ show (solve2 $ parseInput input)

data Coord = Coord {x :: Rational, y :: Rational, z :: Rational} deriving (Show)
type Position = Coord
type Velocity = Position
data Hailstone = Hailstone {position :: Position, velocity :: Velocity} deriving (Show)

parseInput :: String -> [Hailstone]
parseInput input = map parseHailstone (lines input)

parseHailstone :: String -> Hailstone
parseHailstone str = Hailstone (Coord x y z) (Coord dx dy dz) where
    (pos, vel) = splitOn " @ " str
    [x, y, z] = map (toRational . read) $ splitBy ", " pos
    [dx, dy, dz] = map (toRational . read) $ splitBy ", " vel

solve1 :: [Hailstone] -> Int
solve1 hailstones = (`div` 2) . length . filter withinBounds .catMaybes $ intersections where
    intersections = [findXYIntersect h1 h2 | h1 <- hailstones, h2 <- hailstones]
    withinBounds (x, y) = lowerBound <= x && x <= upperBound && lowerBound <= y && y <= upperBound

findXYIntersect :: Hailstone -> Hailstone -> Maybe (Rational, Rational)
findXYIntersect (Hailstone (Coord x1  y1 _) (Coord dx1 dy1 _)) (Hailstone (Coord x2 y2 _) (Coord dx2 dy2 _)) = res where
    res = if dx1 == 0 || dx2 == 0 || m1 == m2 || not inFuture then Nothing else Just (x, y)
    m1 = dy1 / dx1
    m2 = dy2 / dx2
    x = ((y2 - y1) + m1 * x1 - m2 * x2) / (m1 - m2)
    y = m1 * (x - x1) + y1
    inFuture = x `compare` x1 == dx1 `compare` 0 && x `compare` x2 == dx2 `compare` 0

solve2 :: [Hailstone] -> Integer
solve2 hailstones = numerator (x + y + z) where
    possibleVelocities = [(dx, dy) | dx <- [-300..300], dy <- [-300..300]]
    (x, y) = head $ mapMaybe (uncurry $ converge hailstones) possibleVelocities
    flippedHailstones = map swapYZ hailstones
    (_, z) = head $ mapMaybe (uncurry $ converge flippedHailstones) possibleVelocities

converge :: [Hailstone] -> Rational -> Rational -> Maybe (Rational, Rational)
converge hailstones dx dy = res where
    (s1:s2:hailstones') = map (shiftHailstone dx dy) hailstones
    res = case findXYIntersect s1 s2 of
        Nothing -> Nothing
        Just (x, y)
            | all (\r -> findXYIntersect s1 r == Just (x, y)) (s2:hailstones') -> Just (x, y)
            | otherwise -> Nothing

shiftHailstone :: Rational -> Rational -> Hailstone -> Hailstone
shiftHailstone refdx refdy (Hailstone (Coord x y z) (Coord dx dy dz)) =
    Hailstone (Coord x y z) (Coord (dx-refdx) (dy-refdy) dz)

swapYZ :: Hailstone -> Hailstone
swapYZ (Hailstone (Coord x y z) (Coord dx dy dz)) = Hailstone (Coord x z y) (Coord dx dz dy)