diff options
| -rw-r--r-- | day16/main.hs | 4 | ||||
| -rw-r--r-- | day17/input.txt | 1 | ||||
| -rw-r--r-- | day17/main.hs | 77 | ||||
| -rw-r--r-- | day17/test.txt | 1 | ||||
| -rw-r--r-- | utils.hs | 6 |
5 files changed, 84 insertions, 5 deletions
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 @@ -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 [] |