From 324ffcbe83bfaa60430bf02476e93098b2241867 Mon Sep 17 00:00:00 2001 From: Xavier Morel Date: Sun, 22 Dec 2019 13:03:55 +0100 Subject: [PATCH] Add days 10, 11, and 13p1 --- y2019/src/Day10.hs | 61 +++++++++++++++++++++++++++++++++++++++++ y2019/src/Day11.hs | 38 +++++++++++++++++++++++++ y2019/src/Day12.hs | 5 ++++ y2019/src/Day13.hs | 22 +++++++++++++++ y2019/src/Day14.hs | 5 ++++ y2019/src/Day7.hs | 6 ++-- y2019/src/DayPicker.hs | 10 +++++++ y2019/src/Geo/Point.hs | 8 +++--- y2019/src/Geo/Vector.hs | 21 ++++++++++++-- y2019/src/Intcode.hs | 61 +++++++++++++++++++++++++++++++++-------- 10 files changed, 215 insertions(+), 22 deletions(-) create mode 100644 y2019/src/Day10.hs create mode 100644 y2019/src/Day11.hs create mode 100644 y2019/src/Day12.hs create mode 100644 y2019/src/Day13.hs create mode 100644 y2019/src/Day14.hs diff --git a/y2019/src/Day10.hs b/y2019/src/Day10.hs new file mode 100644 index 0000000..00c2c96 --- /dev/null +++ b/y2019/src/Day10.hs @@ -0,0 +1,61 @@ +module Day10 (day10) where + +import Data.List +import Geo.Vector +import Geo.Point + +parseLine :: Int -> [Char] -> [Int] +parseLine xp ('#':cs) = xp:(parseLine (xp + 1) cs) +parseLine xp (_:cs) = parseLine (xp + 1) cs +parseLine _ [] = [] + +parseInput :: Int -> [String] -> [Point] +parseInput yp (l:ls) = (map convertToPoint $ parseLine 0 l) ++ parseInput (yp + 1) ls + where convertToPoint xp = Point (fromIntegral xp) (fromIntegral yp) +parseInput _ [] = [] + +getDirVectors :: Point -> [Point] -> [Vector] +getDirVectors src (dest:dests) = computedVect:(getDirVectors src dests) + where computedVect = roundVecAtN 5 $ directionalVectorFromPoint (dest `sub` src) +getDirVectors _ [] = [] + +getVectorAndDistPerPoint :: [Point] -> Point -> [(Point, Double, Double)] +getVectorAndDistPerPoint (dest:dests) src = (dest, computedVect, distance):nextEntries + where computedVect = vec2angle $ directionalVectorFromPoint diffPt + distance = roundN 5 $ sqrt $ ((Geo.Point.x diffPt) ^ 2) + ((Geo.Point.y diffPt) ^ 2) + diffPt = dest `sub` src + nextEntries = getVectorAndDistPerPoint dests src +getVectorAndDistPerPoint [] _ = [] + +asteroidSorting :: (Point, Double, Double) -> (Point, Double, Double) -> Ordering +asteroidSorting (_, angle1, dist1) (_, angle2, dist2) + | angle1 > angle2 = GT + | angle1 < angle2 = LT + | dist1 > dist2 = GT + | dist1 < dist2 = LT + | otherwise = EQ + +getLaserOrder :: [[Point]] -> [Point] +getLaserOrder ((p:[]):xs) = p:(getLaserOrder xs) +getLaserOrder ((p:ps):xs) = p:(getLaserOrder (xs ++ [ps])) +getLaserOrder [] = [] + +day10 :: IO () +day10 = do + putStrLn $ "AoC 2019 day 10" + input <- getContents + let asteroids = parseInput 0 $ lines input + + let part1 = maximumBy (\(_, a) (_, b) -> compare a b) $ map countFn asteroids + where countFn pt = (pt, (length $ nub $ getDirVectors pt asteroids) - 1) + + putStrLn $ "Part 1: " ++ (show $ part1) + + let p2 = getLaserOrder $ + map (\m -> map (\(p, _, _) -> p) m) $ + groupBy (\(_, v1, _) (_, v2, _) -> v1 == v2) $ + sortBy asteroidSorting $ + getVectorAndDistPerPoint asteroids $ + fst part1 + + putStrLn $ "Part 2: " ++ (show $ p2 !! 200) diff --git a/y2019/src/Day11.hs b/y2019/src/Day11.hs new file mode 100644 index 0000000..0998ddf --- /dev/null +++ b/y2019/src/Day11.hs @@ -0,0 +1,38 @@ +module Day11 (day11) where + +import qualified Data.Map as M +import Data.List +import Intcode + +getCoords :: ([Int] -> Int) -> [((Int, Int), Int)] -> (Int, Int) +getCoords fn (((x, y),_):xs) = getCoords' x y xs + where getCoords' ax ay (((bx, by), _):xs') = getCoords' (fn [ax, bx]) (fn [ay, by]) xs' + getCoords' ax ay [] = (ax, ay) + +drawLine :: Int -> (Int, Int) -> Int -> M.Map (Int, Int) Int -> String +drawLine curY (minX, maxX) curX paint + | curX == maxX = [color, '\n'] + | otherwise = [color] ++ drawLine curY (minX, maxX) (curX + 1) paint + where color = if (M.findWithDefault 0 (curX, curY) paint) == 0 then '.' else '#' + +draw :: M.Map (Int, Int) Int -> String +draw painting = draw' minCoords maxCoords (snd minCoords) + where minCoords = getCoords minimum $ M.toList painting + maxCoords = getCoords maximum $ M.toList painting + draw' (minX, _) (maxX, maxY) curY + | curY == maxY = drawLine curY (minX, maxX) minX painting + | otherwise = (drawLine curY (minX, maxX) minX painting) ++ + (draw' minCoords maxCoords (curY + 1)) + +day11 :: IO () +day11 = do + putStrLn "AoC 2019 day 11" + input <- getLine + let memory = parseProgram input + let painting = runProgramPaint memory 0 + let registration = runProgramPaint memory 1 + + putStrLn $ "Part 1: " ++ (show $ length $ painting) + + putStrLn $ "Part 2:" + putStrLn $ draw registration diff --git a/y2019/src/Day12.hs b/y2019/src/Day12.hs new file mode 100644 index 0000000..d3b3311 --- /dev/null +++ b/y2019/src/Day12.hs @@ -0,0 +1,5 @@ +module Day12 (day12) where + +day12 :: IO () +day12 = do + putStrLn "AoC 2019 day 12" diff --git a/y2019/src/Day13.hs b/y2019/src/Day13.hs new file mode 100644 index 0000000..1dff4e6 --- /dev/null +++ b/y2019/src/Day13.hs @@ -0,0 +1,22 @@ +module Day13 (day13) where + +import Intcode + +parseOutput :: [Int] -> [(Int, Int, Int)] +parseOutput (x:(y:(t:xs))) = (x, y, t):(parseOutput xs) +parseOutput _ = [] + +day13 :: IO () +day13 = do + putStrLn $ "AoC 2019 day 13" + input <- getLine + let memory = parseProgram input + + let outputP1 = parseOutput $ runProgramV2 [] memory + + putStrLn $ "Part1: " ++ (show $ length $ filter (\(_,_,t) -> t == 2) outputP1) + + -- let hackedMemory = 2:xs + -- where (_:xs) = memory + + -- let outputP2 = parseOutput $ runProgramV2 [] hackedMemory diff --git a/y2019/src/Day14.hs b/y2019/src/Day14.hs new file mode 100644 index 0000000..eec0ada --- /dev/null +++ b/y2019/src/Day14.hs @@ -0,0 +1,5 @@ +module Day14 (day14) where + +day14 :: IO () +day14 = do + putStrLn "AoC 2019 day 14" diff --git a/y2019/src/Day7.hs b/y2019/src/Day7.hs index df05719..f585d9b 100644 --- a/y2019/src/Day7.hs +++ b/y2019/src/Day7.hs @@ -35,7 +35,7 @@ day7 = do putStrLn $ "Part 1: " ++ (show p1) -- WIP - let combinationsP2 = testCombinationsP2 program - let p2 = maximumBy (\(_, a) (_, b) -> compare a b) combinationsP2 + -- let combinationsP2 = testCombinationsP2 program + -- let p2 = maximumBy (\(_, a) (_, b) -> compare a b) combinationsP2 - putStrLn $ "Part 2 (WIP/Buggy): " ++ (show p2) + -- putStrLn $ "Part 2 (WIP/Buggy): " ++ (show p2) diff --git a/y2019/src/DayPicker.hs b/y2019/src/DayPicker.hs index 8297597..64e3192 100644 --- a/y2019/src/DayPicker.hs +++ b/y2019/src/DayPicker.hs @@ -14,6 +14,11 @@ import Day6 import Day7 import Day8 import Day9 +import Day10 +import Day11 +import Day12 +import Day13 +import Day14 -- TODO Better way? load :: [String] -> IO () @@ -27,6 +32,11 @@ load ("6":_) = day6 load ("7":_) = day7 load ("8":_) = day8 load ("9":_) = day9 +load ("10":_) = day10 +load ("11":_) = day11 +load ("12":_) = day12 +load ("13":_) = day13 +load ("14":_) = day14 load _ = putStrLn "Unavailable date" dayPicker :: IO () diff --git a/y2019/src/Geo/Point.hs b/y2019/src/Geo/Point.hs index ba45614..c7650b8 100644 --- a/y2019/src/Geo/Point.hs +++ b/y2019/src/Geo/Point.hs @@ -6,15 +6,15 @@ module Geo.Point sub ) where -data Point = Point { x :: Float, y :: Float } deriving (Show) +data Point = Point { x :: Double, y :: Double } deriving (Show, Eq) -instance Eq Point where - (==) (Point x1 y1) (Point x2 y2) = x1 == x2 && y1 == y2 +-- instance Eq Point where +-- (==) (Point x1 y1) (Point x2 y2) = x1 == x2 && y1 == y2 origin :: Point origin = Point 0 0 -manhattanDist :: Point -> Point -> Float +manhattanDist :: Point -> Point -> Double manhattanDist a b = abs(x(b) - x(a)) + abs(y(b) - y(a)) add :: Point -> Point -> Point diff --git a/y2019/src/Geo/Vector.hs b/y2019/src/Geo/Vector.hs index ac6235e..5d8b2e3 100644 --- a/y2019/src/Geo/Vector.hs +++ b/y2019/src/Geo/Vector.hs @@ -4,12 +4,15 @@ module Geo.Vector directionalVectorFromPoint, directionalVectorToPoint, nilVector, - addV2P + addV2P, + roundVecAtN, + roundN, + vec2angle ) where import Geo.Point -data Vector = Vector { x :: Float, y :: Float } deriving (Show) +data Vector = Vector { x :: Double, y :: Double } deriving (Show, Eq) addV2P :: Point -> Vector -> Point addV2P (Point xp yp) (Vector xv yv) = Point (xp + xv) (yp + yv) @@ -17,12 +20,24 @@ addV2P (Point xp yp) (Vector xv yv) = Point (xp + xv) (yp + yv) nilVector :: Vector nilVector = Vector 0 0 +roundVecAtN :: Int -> Vector -> Vector +roundVecAtN prec (Vector vx vy) = Vector (roundN prec vx) (roundN prec vy) + +-- https://stackoverflow.com/questions/12450501/round-number-to-specified-number-of-digits +roundN :: Int -> Double -> Double +roundN prec val = (fromInteger $ round $ val * (10 ^ prec)) / (10.0 ^^ prec) + directionalVectorFromPoint :: Point -> Vector directionalVectorFromPoint (Point px py) = Vector (px / len) (py / len) where len = sqrt(px * px + py * py) -determinantVector :: Vector -> Vector -> Float +determinantVector :: Vector -> Vector -> Double determinantVector (Vector x1 y1) (Vector x2 y2) = (x1 * y2) - (y1 * x2) directionalVectorToPoint :: Vector -> Point -> Point directionalVectorToPoint (Vector vx vy) (Point px py) = Point (vx * px) (vy * py) + +vec2angle :: Vector -> Double +vec2angle (Vector vx vy) = roundN 5 angle' + where angle = atan2 vx vy + angle' = pi - angle diff --git a/y2019/src/Intcode.hs b/y2019/src/Intcode.hs index b732269..400c25e 100644 --- a/y2019/src/Intcode.hs +++ b/y2019/src/Intcode.hs @@ -1,11 +1,13 @@ -module Intcode (parseProgram, runProgramV1, runProgramV2, runProgramV3) where +module Intcode (parseProgram, runProgramV1, runProgramV2, runProgramV3, runProgramPaint) where import Data.Map import Data.List.Split import Data.Char -- import Debug.Trace -trace _ x = x +-- trace _ x = x + +trace' _ x = x data ParamMode = Position | Direct | Relative deriving (Show) @@ -77,7 +79,7 @@ compute s (Instr OpAdd p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemor value1 = getValue s p1 value2 = getValue s p2 result = value1 + value2 - dbg x = trace ("ADD\t\t"++ show p1 ++ " [" ++ show value1 ++ "] + "++ show p2 ++" [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] " ++ show p3) x + dbg x = trace' ("ADD\t\t"++ show p1 ++ " [" ++ show value1 ++ "] + "++ show p2 ++" [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] " ++ show p3) x -- OPCODE 2 - MULTIPLICATION compute s (Instr OpMult p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } where newIndex = (_index s) + 4 @@ -86,7 +88,7 @@ compute s (Instr OpMult p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemo value1 = getValue s p1 value2 = getValue s p2 result = value1 * value2 - dbg x = trace ("MULT\t\t" ++ show p1 ++ " [" ++ show value1 ++ "] * "++ show p2++" [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x + dbg x = trace' ("MULT\t\t" ++ show p1 ++ " [" ++ show value1 ++ "] * "++ show p2++" [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x -- OPCODE 3 - READ compute s (Instr OpRead p1 _ _) = dbg s { _index = newIndex, _memory = newMemory, _input = newInput } where newIndex = (_index s) + 2 @@ -94,25 +96,25 @@ compute s (Instr OpRead p1 _ _) = dbg s { _index = newIndex, _memory = newMemory resultIndex = getWriteAddress s p1 value = head $ _input s newInput = tail $ _input s - dbg x = trace ("READ\t\t[" ++ show value ++ "]\t-> @ [" ++ show resultIndex ++ "] " ++ show p1) x + dbg x = trace' ("READ\t\t[" ++ show value ++ "]\t-> @ [" ++ show resultIndex ++ "] " ++ show p1) x -- OPCODE 4 - OUTPUT compute s (Instr OpWrite p1 _ _) = dbg s { _index = newIndex, _output = newOutput } where newIndex = (_index s) + 2 newOutput = (_output s) ++ [value] value = getValue s p1 - dbg x = trace ("OUTPUT\t\t" ++ show p1 ++ " [" ++ show value ++ "]") x + dbg x = trace' ("OUTPUT\t\t" ++ show p1 ++ " [" ++ show value ++ "]") x -- OPCODE 5 - JUMP-IF-TRUE compute s (Instr OpJumpEq p1 p2 _) = dbg s { _index = newIndex } where value = getValue s p1 jumpTo = getValue s p2 newIndex = if value /= 0 then jumpTo else (_index s) + 3 - dbg x = trace ("JUMP-IF-TRUE\t" ++ show p1 ++ " [" ++ show value ++ "] JMP TO " ++ show p2 ++ " [" ++ show jumpTo ++ "]\t-> INDEX " ++ show newIndex) x + dbg x = trace' ("JUMP-IF-TRUE\t" ++ show p1 ++ " [" ++ show value ++ "] JMP TO " ++ show p2 ++ " [" ++ show jumpTo ++ "]\t-> INDEX " ++ show newIndex) x -- OPCODE 6 - JUMP-IF-FALSE compute s (Instr OpJumpNeq p1 p2 _) = dbg s { _index = newIndex } where value = getValue s p1 jumpTo = getValue s p2 newIndex = if value == 0 then jumpTo else (_index s) + 3 - dbg x = trace ("JUMP-IF-FALSE\t" ++ show p1 ++ " [" ++ show value ++ "] JMP TO " ++ show p2 ++ " [" ++ show jumpTo ++ "]\t-> INDEX " ++ show newIndex) x + dbg x = trace' ("JUMP-IF-FALSE\t" ++ show p1 ++ " [" ++ show value ++ "] JMP TO " ++ show p2 ++ " [" ++ show jumpTo ++ "]\t-> INDEX " ++ show newIndex) x -- OPCODE 7 - LESS-THAN compute s (Instr OpLT p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } where newIndex = (_index s) + 4 @@ -121,7 +123,7 @@ compute s (Instr OpLT p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory resultIndex = getWriteAddress s p3 result = if value1 < value2 then 1 else 0 newMemory = insert resultIndex result (_memory s) - dbg x = trace ("LESS-THAN\t" ++ show p1 ++ " [" ++ show value1 ++ "] vs " ++ show p2 ++ " [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x + dbg x = trace' ("LESS-THAN\t" ++ show p1 ++ " [" ++ show value1 ++ "] vs " ++ show p2 ++ " [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x -- OPCODE 8 - EQUALS compute s (Instr OpEq p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } where newIndex = (_index s) + 4 @@ -130,17 +132,17 @@ compute s (Instr OpEq p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory result = if value1 == value2 then 1 else 0 resultIndex = getWriteAddress s p3 newMemory = insert resultIndex result (_memory s) - dbg x = trace ("EQUALS\t\t" ++ show p1 ++ " [" ++ show value1 ++ "] vs " ++ show p2 ++ " [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x + dbg x = trace' ("EQUALS\t\t" ++ show p1 ++ " [" ++ show value1 ++ "] vs " ++ show p2 ++ " [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x -- OPCODE 9 - REL-OFFSET compute s (Instr OpOffset p1 _ _) = dbg s { _index = newIndex, _relIndex = newRelIndex } where value = getValue s p1 newIndex = (_index s) + 2 relIndex = _relIndex s newRelIndex = value + relIndex - dbg x = trace ("REL-OFFSET\t" ++ show p1 ++ " [" ++ show value ++ "] + CUR [" ++ show relIndex ++ "] =\t[" ++ show newRelIndex ++ "]") x + dbg x = trace' ("REL-OFFSET\t" ++ show p1 ++ " [" ++ show value ++ "] + CUR [" ++ show relIndex ++ "] =\t[" ++ show newRelIndex ++ "]") x -- OPCODE 99 - EXIT compute s (Instr OpExit _ _ _) = dbg s { _running = False } - where dbg x = trace ("EXIT") x + where dbg x = trace' ("EXIT") x -- ELSE: NOT HANDLED -- compute s (Instr n _ _ _) = trace ("Unhandled opcode " ++ show n) s { _running = False } @@ -183,3 +185,38 @@ chainProcesses (amp:nextAmps) input instr = getInstruction amp instrOp = _opcode(instr) out = head (_output amp) + +-- directions: 0 = top, 1 = right, 2 = bot, 3 = left +paintProgram :: State -> (Int, Int) -> Int -> Map (Int, Int) Int -> Map (Int, Int) Int +paintProgram state curPos curDir painting + | _running(state) == False = painting + | instrOp == OpRead = paintProgram paintState newPos newDir newPainting + | otherwise = paintProgram normalState curPos curDir painting + where normalState = compute state instr + paintState = compute state { + _input = [findWithDefault 0 newPos painting], _output = []} instr + instr = getInstruction state + instrOp = _opcode instr + paintOutput = _output state + newPainting = if not (Prelude.null paintOutput) + then insert curPos (paintOutput !! 0) painting + else painting + turn = paintOutput !! 1 + newDir = if not (Prelude.null paintOutput) + then applyTurn turn curDir + else curDir + applyTurn 0 cur = mod (cur - 1) 4 + applyTurn 1 cur = mod (cur + 1) 4 + newPos = if not (Prelude.null paintOutput) + then move curPos newDir + else curPos + move (x, y) 0 = (x, y - 1) + move (x, y) 1 = (x + 1, y) + move (x, y) 2 = (x, y + 1) + move (x, y) 3 = (x - 1, y) + +runProgramPaint :: [Int] -> Int -> Map (Int, Int) Int +runProgramPaint mem initial = paintProgram initialState (0, 0) 0 (initialPaint initial) + where initialState = State 0 0 [initial] [] (makeMemory mem) True + initialPaint 0 = empty + initialPaint 1 = fromList [((0, 0), 1)]