From 63c1f74fe9a20984f6a19c3c2344793b1ed10072 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Fri, 17 Dec 2021 13:25:23 +0200
Subject: Day 17

---
 day16/main.hs   |  4 ---
 day17/input.txt |  1 +
 day17/main.hs   | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 day17/test.txt  |  1 +
 utils.hs        |  6 ++++-
 5 files changed, 84 insertions(+), 5 deletions(-)
 create mode 100644 day17/input.txt
 create mode 100644 day17/main.hs
 create mode 100644 day17/test.txt

diff --git a/day16/main.hs b/day16/main.hs
index 76b3db1..56510ae 100644
--- a/day16/main.hs
+++ b/day16/main.hs
@@ -39,10 +39,6 @@ binaryToInt = reverse .> binaryToInt'
 binaryToInt' [] = 0
 binaryToInt' (x : xs) = digitToInt x + 2 * binaryToInt' xs
 
-takeUntil :: (a -> Bool) -> [a] -> [a]
-takeUntil _ [] = []
-takeUntil p (x : xs) = x : if p x then takeUntil p xs else []
-
 applyOperator opTypeId subValues = case opTypeId of
   0 -> sum subValues
   1 -> product subValues
diff --git a/day17/input.txt b/day17/input.txt
new file mode 100644
index 0000000..cbb29f3
--- /dev/null
+++ b/day17/input.txt
@@ -0,0 +1 @@
+target area: x=138..184, y=-125..-71
diff --git a/day17/main.hs b/day17/main.hs
new file mode 100644
index 0000000..109cbbd
--- /dev/null
+++ b/day17/main.hs
@@ -0,0 +1,77 @@
+module Main where
+
+import Data.Function (on)
+import qualified Data.List as L
+import Data.Maybe (fromJust)
+import qualified Data.Text as T
+import Debug.Trace (traceShow, traceShowId)
+import Utils
+
+type Point = (Int, Int)
+
+data State = State
+  { px :: Int,
+    py :: Int,
+    vx :: Int,
+    vy :: Int
+  }
+  deriving (Show)
+
+-- | Returns the opposite corner points of the target area rectangle
+parseTargetArea :: String -> (Point, Point)
+parseTargetArea input =
+  drop 15 input $> T.pack
+    .> T.replace (T.pack "y=") T.empty
+    .> T.replace (T.pack "..") (T.pack ",")
+    .> T.replace (T.pack " ") T.empty
+    .> T.splitOn (T.pack ",")
+    .> map (T.unpack .> read)
+    .> \[x1, x2, y1, y2] -> ((x1, y1), (x2, y2))
+
+rightHalfPlanePoints = [(x, y) | d <- [0 ..], y <- [- d .. d], x <- [0 .. d], abs x + abs y == d]
+
+simulateStep :: State -> State
+simulateStep state =
+  State
+    { px = px state + vx state,
+      py = py state + vy state,
+      vx = max (vx state - 1) 0,
+      vy = vy state - 1
+    }
+
+pointInRect :: (Point, Point) -> Point -> Bool
+pointInRect ((x1, y1), (x2, y2)) (x, y) =
+  let minX = min x1 x2
+      maxX = max x1 x2
+      minY = min y1 y2
+      maxY = max y1 y2
+   in x >= minX && x <= maxX && y >= minY && y <= maxY
+
+simulateWhile :: (State -> Bool) -> Point -> [Point]
+simulateWhile cond (vx0, vy0) =
+  let initialState =
+        State
+          { px = 0,
+            py = 0,
+            vx = vx0,
+            vy = vy0
+          }
+      steps = iterate simulateStep initialState
+      result = takeUntil cond steps
+   in map (\state -> (px state, py state)) result
+
+run :: (Point, Point) -> (Int, Int)
+run targetArea@((x1, y1), (x2, y2)) =
+  let v0s = take 100000 rightHalfPlanePoints
+      xBound = x2
+      yBound = min 0 y1
+      trajectories = v0s $> map (simulateWhile (\(State px py _ _) -> px <= xBound && py >= yBound))
+      successful = trajectories $> filter (any (pointInRect targetArea))
+   in (snd $ L.maximumBy (compare `on` snd) (concat successful), length successful)
+
+main :: IO ()
+main = do
+  contents <- getContents
+  let targetArea = parseTargetArea contents
+
+  print $ run targetArea
\ No newline at end of file
diff --git a/day17/test.txt b/day17/test.txt
new file mode 100644
index 0000000..a07e02d
--- /dev/null
+++ b/day17/test.txt
@@ -0,0 +1 @@
+target area: x=20..30, y=-10..-5
diff --git a/utils.hs b/utils.hs
index 9fcc553..3e6c2b6 100644
--- a/utils.hs
+++ b/utils.hs
@@ -39,4 +39,8 @@ splitToPair f lst =
    in (x', y')
 
 count :: (a -> Bool) -> [a] -> Int
-count pred xs = xs $> filter pred .> length
\ No newline at end of file
+count pred xs = xs $> filter pred .> length
+
+takeUntil :: (a -> Bool) -> [a] -> [a]
+takeUntil _ [] = []
+takeUntil p (x : xs) = x : if p x then takeUntil p xs else []
-- 
cgit v1.3