Add days 10, 11, and 13p1

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)

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

y2019/src/Day12.hs

@@ -0,0 +1,5 @@
+module Day12 (day12) where
+
+day12 :: IO ()
+day12 = do
+  putStrLn "AoC 2019 day 12"

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

y2019/src/Day14.hs

@@ -0,0 +1,5 @@
+module Day14 (day14) where
+
+day14 :: IO ()
+day14 = do
+  putStrLn "AoC 2019 day 14"

y2019/src/Day7.hs

@@ -35,7 +35,7 @@ day7 = do
   putStrLn $ "Part 1: " ++ (show p1)
 
   -- WIP
-  let combinationsP2 = testCombinationsP2 program
+  -- let combinationsP2 = testCombinationsP2 program
-  let p2 = maximumBy (\(_, a) (_, b) -> compare a b) combinationsP2
+  -- let p2 = maximumBy (\(_, a) (_, b) -> compare a b) combinationsP2
 
-  putStrLn $ "Part 2 (WIP/Buggy): " ++ (show p2)
+  -- putStrLn $ "Part 2 (WIP/Buggy): " ++ (show p2)

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 ()

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
+-- instance Eq Point where
-  (==) (Point x1 y1) (Point x2 y2) = x1 == x2 && y1 == y2
+--   (==) (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

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

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)]