Initial commit with Day 1, 2 and part of 3

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

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