Day 24

2023-12-30 22:33:03 +01:00
parent c568ce2677
commit 262ad03e46
5 changed files with 121 additions and 0 deletions
--- a/day24/Part1.hs
+++ b/day24/Part1.hs
@@ -0,0 +1,52 @@
+module Part1 where
+
+import Commons
+
+
+getCoords :: (Int, Int) -> Hailstone -> ((Double, Double), (Double, Double))
+getCoords (minP, maxP) h =
+  let xSteps = if vx h > 0 then fromIntegral (abs (maxP - x h)) / fromIntegral (vx h)
+               else fromIntegral (abs (minP - x h)) / fromIntegral (-1 * vx h)
+      ySteps = if vy h > 0 then fromIntegral (abs (maxP - y h)) / fromIntegral (vy h)
+               else fromIntegral (abs (minP - y h)) / fromIntegral (-1 * vy h)
+      ((x1, y1), (x2, y2)) = if xSteps < ySteps
+                             then ((fromIntegral $ x h, fromIntegral $ y h),
+                                   (fromIntegral (x h) + xSteps * fromIntegral (vx h),
+                                    fromIntegral (y h) + xSteps * fromIntegral (vy h)))
+                             else ((fromIntegral $ x h, fromIntegral $ y h),
+                                   (fromIntegral (x h) + ySteps * fromIntegral (vx h),
+                                    fromIntegral (y h) + ySteps * fromIntegral (vy h)))
+  in ((x1, y1), (x2, y2))
+
+getIntersection :: ((Double, Double), (Double, Double)) -> ((Double, Double), (Double, Double)) ->
+                   Maybe (Double, Double)
+getIntersection ((x1, y1), (x2, y2)) ((x3, y3), (x4, y4)) =
+  let c = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+  in if abs c < 0.01 then Nothing
+     else let a = x1 * y2 - y1 * x2
+              b = x3 * y4 - y3 * x4
+              x = (a * (x3 - x4) - b * (x1 - x2)) / c
+              y = (a * (y3 - y4) - b * (y1 - y2)) / c
+          in Just (x, y)
+
+checkIntersect :: (Int, Int) -> Hailstone -> Hailstone -> Maybe (Double, Double)
+checkIntersect (minP, maxP) h1 h2 =
+  let ((x1, y1), (x2, y2)) = getCoords (minP, maxP) h1
+      ((x3, y3), (x4, y4)) = getCoords (minP, maxP) h2
+      dMinP                = fromIntegral minP
+      dMaxP                = fromIntegral maxP
+  in case getIntersection ((x1, y1), (x2, y2)) ((x3, y3), (x4, y4)) of
+          Nothing     -> Nothing
+          Just (x, y) -> if x >= min x1 x2 && x <= max x1 x2 && x >= min x3 x4 && x <= max x3 x4
+                            && x >= dMinP && x <= dMaxP && y >= dMinP && y <= dMaxP
+                         then Just (x, y) else Nothing
+
+getIntersections :: (Int, Int) -> [Hailstone] -> [Hailstone] -> [(Double, Double)]
+getIntersections _ [_] _ = []
+getIntersections p (_: h: t) [] = getIntersections p (h: t) t
+getIntersections p (h1: t1) (h2: t2) = case checkIntersect p h1 h2 of
+                                            Just (x, y) -> (x, y): getIntersections p (h1: t1) t2
+                                            Nothing     -> getIntersections p (h1: t1) t2
+
+findIntersections :: (Int, Int) -> [Hailstone] -> [(Double, Double)]
+findIntersections p (h: t) = getIntersections p (h: t) t