Initial commit with Day 1, 2 and part of 3

Signed-off-by: Alek Ratzloff <alekratz@gmail.com>

.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

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)

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)
+-}

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

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)
+    }
+