diff --git a/day03/Day03.hs b/day03/Day03.hs index 9bea669..b9d3da7 100644 --- a/day03/Day03.hs +++ b/day03/Day03.hs @@ -8,27 +8,32 @@ main = do let input = parseInput inputText putStr "Part 1: " putStrLn $ part1 input - putStrLn $ show $ applyAt (-4, 4) emptyBoard + --putStrLn $ show $ applyAt (-4, 4) emptyBoard part1 :: (Wires, Wires) -> String -part1 _ = " " +part1 (first:wires1, _) = do + let _ = applyWire first emptyBoard parseInput :: String -> (Wires, Wires) parseInput input = (wires1, wires2) where - wires1:wires2:_ = input |> lines |> fmap (splitOn "," .> fmap parseDir) + wires1:wires2:_ = input |> lines |> fmap (splitOn "," .> fmap parseWire) + +applyWire :: Wire -> Board -> Board +applyWire wire board + | wireMag wire == 0 = board + | otherwise = applyWire (wireMap (pred) wire) $ moveBoardPos wire (applyAtPos board) applyAtPos :: Board -> Board applyAtPos board = applyAt (pos board) board applyAt :: (Int, Int) -> Board -> Board -applyAt (x, y) board = - board |> growBoard (x * 2, y * 2) |> mapBoardMat (updateMat (x, y)) +applyAt (x, y) board = board |> growBoard (x + 2, y + 2) |> mapBoardMat (updateMat (x, y)) --applyWires :: Wires -> Board -> Board --applyWires wires board = ---applyWire :: Dir -> Board -> Board -type Wires = [Dir] +--applyWire :: Wire -> Board -> Board +type Wires = [Wire] type Mat = [[Bool]] @@ -65,11 +70,7 @@ growBoardX x board = do mapBoardMat :: (Mat -> Mat) -> Board -> Board mapBoardMat mapping board = - Board - { mat = withBoardMat mapping board - , pos = (pos board) - , origin = (origin board) - } + Board {mat = withBoardMat mapping board, pos = (pos board), origin = (origin board)} withBoardMat :: (Mat -> a) -> Board -> a withBoardMat mapping board = (mapping (mat board)) @@ -81,6 +82,12 @@ mapBoardOrigin mapping board = withBoardOrigin :: ((Int, Int) -> a) -> Board -> a withBoardOrigin mapping board = (mapping (origin board)) +moveBoardPos :: Wire -> Board -> Board +moveBoardPos wire board = newBoard + where + (wireX, wireY) = wireDir wire + newBoard = mapBoardPos (\(posX, posY) -> (posX + wireX, posY + wireY)) board + mapBoardPos :: ((Int, Int) -> (Int, Int)) -> Board -> Board mapBoardPos mapping board = Board {mat = mat board, pos = mapping (pos board), origin = origin board} @@ -93,9 +100,7 @@ instance Show Board where concat $ intersperse "\n" - [ [boardChar (x, y) board | (x, _) <- zip [0 ..] row] - | (y, row) <- zip [0 ..] (mat board) - ] + [[boardChar (x, y) board | (x, _) <- zip [0 ..] row] | (y, row) <- zip [0 ..] (mat board)] boardChar :: (Int, Int) -> Board -> Char boardChar loc board @@ -107,14 +112,14 @@ boardChar loc board then '+' else '.' -data Dir +data Wire = Up Int | Dn Int | Lt Int | Rt Int -parseDir :: String -> Dir -parseDir text = do +parseWire :: String -> Wire +parseWire text = do let n = read $ tail text case text !! 0 of 'U' -> Up n @@ -122,23 +127,29 @@ parseDir text = do '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) +wireMap :: (Int -> Int) -> Wire -> Wire +wireMap mapping (Up n) = Up (mapping n) +wireMap mapping (Dn n) = Dn (mapping n) +wireMap mapping (Lt n) = Lt (mapping n) +wireMap 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 +wireMag :: Wire -> Int +wireMag (Up n) = n +wireMag (Dn n) = n +wireMag (Lt n) = n +wireMag (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) +wirePair :: Wire -> (Int, Int) +wirePair (Up n) = (0, -n) +wirePair (Dn n) = (0, n) +wirePair (Lt n) = (-n, 0) +wirePair (Rt n) = (n, 0) + +wireDir :: Wire -> (Int, Int) +wireDir (Up n) = (0, -1) +wireDir (Dn n) = (0, 1) +wireDir (Lt n) = (-1, 0) +wireDir (Rt n) = (1, 0) updateMat :: (Int, Int) -> Mat -> Mat updateMat (x, y) mat = newMat @@ -148,10 +159,10 @@ updateMat (x, y) mat = newMat (colHead, _:colTail) = splitAt x row newMat = rowHead ++ [colHead ++ True : colTail] ++ rowTail -growMatDir :: Dir -> Mat -> Mat -growMatDir dir mat - | dirMag dir == 0 = mat - | otherwise = growMat (dirPair dir) mat +growMatWire :: Wire -> Mat -> Mat +growMatWire wire mat + | wireMag wire == 0 = mat + | otherwise = growMat (wirePair wire) mat growMat :: (Int, Int) -> Mat -> Mat growMat (x, y) mat = growMatX x (growMatY y mat)