commit a2297e765a500b5569f3c6633bd2bd46744bc12f Author: Alek Ratzloff Date: Tue Dec 3 17:57:43 2019 -0500 Initial commit with Day 1, 2 and part of 3 Signed-off-by: Alek Ratzloff diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2e550fb --- /dev/null +++ b/.gitignore @@ -0,0 +1,48 @@ +Day[0-9][0-9] +input.txt + +### Haskell ### +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* + +### Vim ### +# Swap +[._]*.s[a-v][a-z] +[._]*.sw[a-p] +[._]s[a-rt-v][a-z] +[._]ss[a-gi-z] +[._]sw[a-p] + +# Session +Session.vim +Sessionx.vim + +# Temporary +.netrwhist +*~ +# Auto-generated tag files +tags +# Persistent undo +[._]*.un~ + +# End of https://www.gitignore.io/api/vim,haskell diff --git a/day01/Day01.hs b/day01/Day01.hs new file mode 100644 index 0000000..388e390 --- /dev/null +++ b/day01/Day01.hs @@ -0,0 +1,22 @@ +main :: IO() +main = do + inputText <- getContents + let inputValues = map read (lines inputText) + putStr "Part 1: " + putStrLn $ show (part1 inputValues) + putStr "Part 2: " + putStrLn $ show (part2 inputValues) + +part1 :: [Int] -> Int +part1 numbers = sum $ map fuelReq numbers + +fuelReq :: Int -> Int +fuelReq mass = max 0 ((mass `div` 3) - 2) + +part2 :: [Int] -> Int +part2 numbers = sum $ map fullFuelReq numbers + +fullFuelReq :: Int -> Int +fullFuelReq mass = + if fuelReq mass == 0 then 0 + else (fuelReq mass) + (fullFuelReq $ fuelReq mass) diff --git a/day02/Day02.hs b/day02/Day02.hs new file mode 100644 index 0000000..48974fc --- /dev/null +++ b/day02/Day02.hs @@ -0,0 +1,81 @@ +import Data.List +import Data.List.Split + +main :: IO() +main = do + inputText <- getContents + let program = map read $ splitOn "," inputText + putStr "Part 1: " + putStrLn $ show (part1 program) + putStr "Part 2: " + putStrLn $ show (part2 19690720 program) + +part1 :: [Int] -> Int +part1 program = (runProgram program (12, 2)) !! 0 + +part2 :: Int -> [Int] -> Int +part2 target program = do + let testList = crossProduct [0..99] [0..99] + let loadedProgram = runProgram program + let solution = find (\(result, _) -> (result !! 0) == target) + (map (\params -> (loadedProgram params, params)) testList) + let (noun, verb) = case solution of + Just (_, params) -> params + Nothing -> error "could not find a solution" + (noun * 100) + verb + +runProgram :: [Int] -> (Int, Int) -> [Int] +runProgram program (noun, verb) = do + let program' = (updateSlotAt 1 noun (updateSlotAt 2 verb program)) + runProgram' 0 program' + +runProgram' :: Int -> [Int] -> [Int] +runProgram' pc program = case program !! pc of + 1 -> result + 2 -> result + 99 -> program + _ -> error "bad opcode" + where + (op, in1, in2, out) = getOps pc program + inValue1 = program !! in1 + inValue2 = program !! in2 + opResult = if op == 1 + then inValue1 + inValue2 + else inValue1 * inValue2 + updatedProgram = updateSlotAt out opResult program + result = runProgram' (pc + 4) updatedProgram + +updateSlotAt :: Int -> Int -> [Int] -> [Int] +updateSlotAt n value program + | n >= length program = error $ "bad program (tried to update at location " ++ (show n) ++ ")" + | otherwise = do + let (first, _ : trailing) = splitAt n program + first ++ (value : trailing) + +getOps :: Int -> [Int] -> (Int, Int, Int, Int) +getOps pc program = do + let (ops, _) = splitAt (pc + 4) program + case reverse ops of + out : in2 : in1 : op : _ -> (op, in1, in2, out) + _ -> error $ "bad program (tried to get values at location " ++ (show pc) ++ ")" + +crossProduct :: [a] -> [b] -> [(a, b)] +crossProduct xs ys = [(x, y) | x <- xs, y <- ys] + +{- +fmtProgram :: Int -> [Int] -> String +fmtProgram hilight program = fmtProgram' hilight 0 program + +fmtProgram' :: Int -> Int -> [Int] -> String +fmtProgram' _ _ [] = "" +fmtProgram' hilight pc program = do + --let (_, _, _, updates) = getOps pc program + let (line, remaining) = splitAt 4 program + let lineStr = if hilight == pc + then "\ESC[47;1m" ++ (fmtLine line) ++ "\ESC[0m" + else (fmtLine line) + (show pc ) ++ " | " ++ lineStr ++ "\n" ++ (fmtProgram' hilight (pc + 4) remaining) + +fmtLine :: [Int] -> String +fmtLine line = concat $ intersperse " " (map show line) +-} diff --git a/day03/Day03.hs b/day03/Day03.hs new file mode 100644 index 0000000..27dd692 --- /dev/null +++ b/day03/Day03.hs @@ -0,0 +1,173 @@ +import Data.List +import Data.List.Split +import Flow + +main :: IO () +main = do + inputText <- getContents + let input = parseInput inputText + putStr "Part 1: " + putStrLn $ part1 input + --putStrLn $ show $ growBoard (-5, -6) $ growBoard (5, 6) emptyBoard + +part1 :: ([Dir], [Dir]) -> String +part1 _ = " " + +parseInput :: String -> ([Dir], [Dir]) +parseInput input = (wires1, wires2) + where + wires1:wires2:_ = input |> lines |> map (splitOn "," .> map parseDir) + +type Mat = [[Bool]] + +data Board = + Board + { mat :: Mat + , pos :: (Int, Int) + , origin :: (Int, Int) + } + +emptyBoard :: Board +emptyBoard = Board {mat = [], pos = (0, 0), origin = (0, 0)} + +ensureBoardPos :: (Int, Int) -> Board -> Board +ensureBoardPos _ board = board + +growBoard :: (Int, Int) -> Board -> Board +growBoard (x, y) board = growBoardX x (growBoardY y board) + +growBoardY :: Int -> Board -> Board +growBoardY 0 board = board +growBoardY y board = do + let incY (x0, y0) = (x0, y0 + abs y) + let newBoard = mapBoardMat (growMatY y) board + if y < 0 + then mapBoardPos incY $ mapBoardOrigin incY newBoard + else newBoard + +growBoardX :: Int -> Board -> Board +growBoardX 0 board = board +growBoardX x board = do + let incX (x0, y0) = (x0 + abs x, y0) + let newBoard = mapBoardMat (growMatX x) board + if x < 0 + then mapBoardPos incX $ mapBoardOrigin incX newBoard + else newBoard + +mapBoardMat :: (Mat -> Mat) -> Board -> Board +mapBoardMat mapping board = + Board + { mat = withBoardMat mapping board + , pos = (pos board) + , origin = (origin board) + } + +withBoardMat :: (Mat -> a) -> Board -> a +withBoardMat mapping board = (mapping (mat board)) + +mapBoardOrigin :: ((Int, Int) -> (Int, Int)) -> Board -> Board +mapBoardOrigin mapping board = + Board {mat = mat board, pos = pos board, origin = mapping (origin board)} + +withBoardOrigin :: ((Int, Int) -> a) -> Board -> a +withBoardOrigin mapping board = (mapping (origin board)) + +mapBoardPos :: ((Int, Int) -> (Int, Int)) -> Board -> Board +mapBoardPos mapping board = + Board {mat = mat board, pos = mapping (pos board), origin = origin board} + +withBoardPos :: ((Int, Int) -> a) -> Board -> a +withBoardPos mapping board = (mapping (pos board)) + +instance Show Board where + show board = + concat $ + intersperse + "\n" + [ [boardChar (x, y) board | (x, _) <- zip [0 ..] row] + | (y, row) <- zip [0 ..] (mat board) + ] + +boardChar :: (Int, Int) -> Board -> Char +boardChar loc board + | (origin board) == loc = 'o' + | (pos board) == loc = '*' + | otherwise = do + let (x, y) = loc + if (mat board) !! y !! x + then '+' + else '.' + +data Dir + = Up Int + | Dn Int + | Lt Int + | Rt Int + +parseDir :: String -> Dir +parseDir text = do + let n = read $ tail text + case text !! 0 of + 'U' -> Up n + 'D' -> Dn n + 'L' -> Lt n + 'R' -> Rt n + +dirMap :: (Int -> Int) -> Dir -> Dir +dirMap mapping (Up n) = Up (mapping n) +dirMap mapping (Dn n) = Dn (mapping n) +dirMap mapping (Lt n) = Lt (mapping n) +dirMap mapping (Rt n) = Rt (mapping n) + +dirMag :: Dir -> Int +dirMag (Up n) = n +dirMag (Dn n) = n +dirMag (Lt n) = n +dirMag (Rt n) = n + +dirPair :: Dir -> (Int, Int) +dirPair (Up n) = (0, -n) +dirPair (Dn n) = (0, n) +dirPair (Lt n) = (-n, 0) +dirPair (Rt n) = (n, 0) + +growMatDir :: Dir -> Mat -> Mat +growMatDir dir mat + | dirMag dir == 0 = mat + | otherwise = growMat (dirPair dir) mat + +growMat :: (Int, Int) -> Mat -> Mat +growMat (x, y) mat = growMatX x (growMatY y mat) + +growMatX :: Int -> Mat -> Mat +growMatX 0 mat = mat +growMatX x mat = + if x < 0 + then [take (abs x) (repeat False) ++ row | row <- mat] + else [row ++ take (abs x) (repeat False) | row <- mat] + +growMatY :: Int -> Mat -> Mat +growMatY 0 mat = mat +growMatY y mat = + if y < 0 + then (take (abs y) (repeat (take (matW mat) (repeat False)))) ++ mat + else mat ++ (take (abs y) (repeat (take (matW mat) (repeat False)))) + +matSize :: Mat -> (Int, Int) +matSize mat = (matW mat, matH mat) + +matW :: Mat -> Int +matW mat = + if matH mat == 0 + then 0 + else mx (map length mat) + +matH :: Mat -> Int +matH mat = length mat + +mx :: [Int] -> Int +mx [] = 0 +mx [x] = x +mx (x:xs) + | (mx xs) > x = mx xs + | otherwise = x diff --git a/day03/Day03.old.hs b/day03/Day03.old.hs new file mode 100644 index 0000000..14f8a5d --- /dev/null +++ b/day03/Day03.old.hs @@ -0,0 +1,162 @@ +import Debug.Trace +import Data.List +import Data.List.Split + +data Dir = Up Int | Dn Int | Lt Int | Rt Int + +dirMap :: (Int -> Int) -> Dir -> Dir +dirMap mapping dir = case dir of + Up n -> Up $ mapping n + Dn n -> Dn $ mapping n + Lt n -> Lt $ mapping n + Rt n -> Rt $ mapping n + +dirAbs :: Dir -> Int +dirAbs dir = case dir of + Up n -> n + Dn n -> n + Lt n -> n + Rt n -> n + +data WireBoard = WireBoard { + board :: [[Bool]], + origin :: (Int, Int), + pos :: (Int, Int) +} + +instance Show WireBoard where + show wireBoard = + concat $ intersperse "\n" [ + [ + wireBoardChar (x, y) wireBoard | (x, _) <- (zip [0..] row) + ] | (y, row) <- (zip [0..] (board wireBoard)) + ] + +wireBoardChar :: (Int, Int) -> WireBoard -> Char +wireBoardChar lookup wireBoard + | lookup == (origin wireBoard) = 'o' + | lookup == (pos wireBoard) = '*' + | otherwise = do + let (posX, posY) = lookup + if (board wireBoard) !! posY !! posX + then '+' + else '.' + +emptyWireBoard :: WireBoard +emptyWireBoard = WireBoard { board = [], origin = (0, 0), pos = (0, 0) } + +parseDir :: String -> Dir +parseDir dir = do + let num = read (tail dir) + case dir !! 0 of + 'U' -> Up num + 'D' -> Dn num + 'L' -> Lt num + 'R' -> Rt num + _ -> error $ "bad direction: " ++ dir + +parseInput :: String -> ([Dir], [Dir]) +parseInput inputText = do + let [first, second] = map (splitOn ",") (lines inputText) + (map parseDir first, map parseDir second) + +main :: IO() +main = do + inputText <- getContents + let wires = parseInput inputText + putStrLn $ show $ applyWire (Dn 3) emptyWireBoard + --putStr "Part 1: " + --putStrLn $ show (part1 wires) + +part1 :: ([Dir], [Dir]) -> Int +part1 (wire1, wire2) = error "TODO" + +applyWire :: Dir -> WireBoard -> WireBoard +applyWire dir wireBoard + | (dirAbs dir) == 0 = applyAtPos wireBoard + | otherwise = do + let nextBoard = applyOne dir wireBoard + applyWire (dirMap (pred) dir) nextBoard + +applyOne :: Dir -> WireBoard -> WireBoard +applyOne (Up _) wireBoard = applyMove (0, -1) wireBoard +applyOne (Dn _) wireBoard = applyMove (0, 1) wireBoard +applyOne (Lt _) wireBoard = applyMove (-1, 0) wireBoard +applyOne (Rt _) wireBoard = applyMove (1, 0) wireBoard + +applyMove :: (Int, Int) -> WireBoard -> WireBoard +applyMove (x, y) wireBoard = do + let newBoard = applyAtPos wireBoard + let (oldX, oldY) = (pos newBoard) + let (newX, newY) = (oldX + x, oldY + y) + WireBoard { + board = (board newBoard), + origin = (origin newBoard), + pos = (newX, newY) + } + +applyAtPos :: WireBoard -> WireBoard +applyAtPos wireBoard = applyAt (pos wireBoard) wireBoard + +applyAt :: (Int, Int) -> WireBoard -> WireBoard +applyAt (x, y) wireBoard = do + let matrix = board (ensureBoardSize (x, y) wireBoard) + let splitMatrix = splitAt (trace ("splitting at " ++ (show y)) y) matrix + let (headRows, row : tailRows) = trace (show splitMatrix) splitMatrix + let (headCols, _ : tailCols) = splitAt x row + let newBoard = headRows ++ [headCols ++ True : tailCols] ++ tailRows + WireBoard { + board = newBoard, + origin = (origin wireBoard), + pos = (pos wireBoard) + } + +ensureBoardSize :: (Int, Int) -> WireBoard -> WireBoard +ensureBoardSize (x, y) wireBoard = do + let (maxX, maxY) = maxBoardPos wireBoard + let (minX, minY) = minBoardPos wireBoard + let growLeft = max 0 $ minX - x + let growRight = max 0 $ x - maxX + let growUp = max 0 $ minY - y + let growDown = max 0 $ y - maxY + growBoard wireBoard (growUp, growDown, growLeft, growRight) + +maxBoardPos :: WireBoard -> (Int, Int) +maxBoardPos wireBoard = do + let (originX, originY) = (origin wireBoard) + let (sizeX, sizeY) = (boardSize wireBoard) + (sizeX - originX, sizeY - originY) + +minBoardPos :: WireBoard -> (Int, Int) +minBoardPos wireBoard = do + let (originX, originY) = (origin wireBoard) + let (sizeX, sizeY) = (boardSize wireBoard) + (originX - sizeX, originY - sizeY) + +boardSize :: WireBoard -> (Int, Int) +boardSize wireBoard = do + let ymax = length (board wireBoard) + if ymax == 0 + then (0, 0) + else (length $ ((board wireBoard) !! 0), ymax) + +growBoard :: WireBoard -> (Int, Int, Int, Int) -> WireBoard +growBoard wireBoard (0, 0, 0, 0) = wireBoard +growBoard wireBoard (up, down, left, right) = do + let (oldX, _) = (boardSize wireBoard) + let newX = oldX + left + right + let newTop = [[False | _ <- [0..newX]] | _ <- [1..up]] + let newBottom = [[False | _ <- [0..newX]] | _ <- [0..down]] + let newMiddle = [ + [False | _ <- [1..left]] ++ middle ++ [False | _ <- [0..right]] + | middle <- (board wireBoard) + ] + let newBoard = newTop ++ newMiddle ++ newBottom + let (originX, originY) = (origin wireBoard) + let (posX, posY) = (pos wireBoard) + WireBoard { + board = newBoard, + origin = (originX + left, originY + up), + pos = (posX + left, posY + up) + } +