Rename Dir -> Wire in day03 haskell impl, don't know if I'll finish it but maybe I will
Signed-off-by: Alek Ratzloff <alekr@jsausa.com>
This commit is contained in:
@@ -8,27 +8,32 @@ main = do
|
|||||||
let input = parseInput inputText
|
let input = parseInput inputText
|
||||||
putStr "Part 1: "
|
putStr "Part 1: "
|
||||||
putStrLn $ part1 input
|
putStrLn $ part1 input
|
||||||
putStrLn $ show $ applyAt (-4, 4) emptyBoard
|
--putStrLn $ show $ applyAt (-4, 4) emptyBoard
|
||||||
|
|
||||||
part1 :: (Wires, Wires) -> String
|
part1 :: (Wires, Wires) -> String
|
||||||
part1 _ = " "
|
part1 (first:wires1, _) = do
|
||||||
|
let _ = applyWire first emptyBoard
|
||||||
|
|
||||||
parseInput :: String -> (Wires, Wires)
|
parseInput :: String -> (Wires, Wires)
|
||||||
parseInput input = (wires1, wires2)
|
parseInput input = (wires1, wires2)
|
||||||
where
|
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 -> Board
|
||||||
applyAtPos board = applyAt (pos board) board
|
applyAtPos board = applyAt (pos board) board
|
||||||
|
|
||||||
applyAt :: (Int, Int) -> Board -> Board
|
applyAt :: (Int, Int) -> Board -> Board
|
||||||
applyAt (x, y) board =
|
applyAt (x, y) board = board |> growBoard (x + 2, y + 2) |> mapBoardMat (updateMat (x, y))
|
||||||
board |> growBoard (x * 2, y * 2) |> mapBoardMat (updateMat (x, y))
|
|
||||||
|
|
||||||
--applyWires :: Wires -> Board -> Board
|
--applyWires :: Wires -> Board -> Board
|
||||||
--applyWires wires board =
|
--applyWires wires board =
|
||||||
--applyWire :: Dir -> Board -> Board
|
--applyWire :: Wire -> Board -> Board
|
||||||
type Wires = [Dir]
|
type Wires = [Wire]
|
||||||
|
|
||||||
type Mat = [[Bool]]
|
type Mat = [[Bool]]
|
||||||
|
|
||||||
@@ -65,11 +70,7 @@ growBoardX x board = do
|
|||||||
|
|
||||||
mapBoardMat :: (Mat -> Mat) -> Board -> Board
|
mapBoardMat :: (Mat -> Mat) -> Board -> Board
|
||||||
mapBoardMat mapping board =
|
mapBoardMat mapping board =
|
||||||
Board
|
Board {mat = withBoardMat mapping board, pos = (pos board), origin = (origin board)}
|
||||||
{ mat = withBoardMat mapping board
|
|
||||||
, pos = (pos board)
|
|
||||||
, origin = (origin board)
|
|
||||||
}
|
|
||||||
|
|
||||||
withBoardMat :: (Mat -> a) -> Board -> a
|
withBoardMat :: (Mat -> a) -> Board -> a
|
||||||
withBoardMat mapping board = (mapping (mat board))
|
withBoardMat mapping board = (mapping (mat board))
|
||||||
@@ -81,6 +82,12 @@ mapBoardOrigin mapping board =
|
|||||||
withBoardOrigin :: ((Int, Int) -> a) -> Board -> a
|
withBoardOrigin :: ((Int, Int) -> a) -> Board -> a
|
||||||
withBoardOrigin mapping board = (mapping (origin board))
|
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 :: ((Int, Int) -> (Int, Int)) -> Board -> Board
|
||||||
mapBoardPos mapping board =
|
mapBoardPos mapping board =
|
||||||
Board {mat = mat board, pos = mapping (pos board), origin = origin board}
|
Board {mat = mat board, pos = mapping (pos board), origin = origin board}
|
||||||
@@ -93,9 +100,7 @@ instance Show Board where
|
|||||||
concat $
|
concat $
|
||||||
intersperse
|
intersperse
|
||||||
"\n"
|
"\n"
|
||||||
[ [boardChar (x, y) board | (x, _) <- zip [0 ..] row]
|
[[boardChar (x, y) board | (x, _) <- zip [0 ..] row] | (y, row) <- zip [0 ..] (mat board)]
|
||||||
| (y, row) <- zip [0 ..] (mat board)
|
|
||||||
]
|
|
||||||
|
|
||||||
boardChar :: (Int, Int) -> Board -> Char
|
boardChar :: (Int, Int) -> Board -> Char
|
||||||
boardChar loc board
|
boardChar loc board
|
||||||
@@ -107,14 +112,14 @@ boardChar loc board
|
|||||||
then '+'
|
then '+'
|
||||||
else '.'
|
else '.'
|
||||||
|
|
||||||
data Dir
|
data Wire
|
||||||
= Up Int
|
= Up Int
|
||||||
| Dn Int
|
| Dn Int
|
||||||
| Lt Int
|
| Lt Int
|
||||||
| Rt Int
|
| Rt Int
|
||||||
|
|
||||||
parseDir :: String -> Dir
|
parseWire :: String -> Wire
|
||||||
parseDir text = do
|
parseWire text = do
|
||||||
let n = read $ tail text
|
let n = read $ tail text
|
||||||
case text !! 0 of
|
case text !! 0 of
|
||||||
'U' -> Up n
|
'U' -> Up n
|
||||||
@@ -122,23 +127,29 @@ parseDir text = do
|
|||||||
'L' -> Lt n
|
'L' -> Lt n
|
||||||
'R' -> Rt n
|
'R' -> Rt n
|
||||||
|
|
||||||
dirMap :: (Int -> Int) -> Dir -> Dir
|
wireMap :: (Int -> Int) -> Wire -> Wire
|
||||||
dirMap mapping (Up n) = Up (mapping n)
|
wireMap mapping (Up n) = Up (mapping n)
|
||||||
dirMap mapping (Dn n) = Dn (mapping n)
|
wireMap mapping (Dn n) = Dn (mapping n)
|
||||||
dirMap mapping (Lt n) = Lt (mapping n)
|
wireMap mapping (Lt n) = Lt (mapping n)
|
||||||
dirMap mapping (Rt n) = Rt (mapping n)
|
wireMap mapping (Rt n) = Rt (mapping n)
|
||||||
|
|
||||||
dirMag :: Dir -> Int
|
wireMag :: Wire -> Int
|
||||||
dirMag (Up n) = n
|
wireMag (Up n) = n
|
||||||
dirMag (Dn n) = n
|
wireMag (Dn n) = n
|
||||||
dirMag (Lt n) = n
|
wireMag (Lt n) = n
|
||||||
dirMag (Rt n) = n
|
wireMag (Rt n) = n
|
||||||
|
|
||||||
dirPair :: Dir -> (Int, Int)
|
wirePair :: Wire -> (Int, Int)
|
||||||
dirPair (Up n) = (0, -n)
|
wirePair (Up n) = (0, -n)
|
||||||
dirPair (Dn n) = (0, n)
|
wirePair (Dn n) = (0, n)
|
||||||
dirPair (Lt n) = (-n, 0)
|
wirePair (Lt n) = (-n, 0)
|
||||||
dirPair (Rt 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 :: (Int, Int) -> Mat -> Mat
|
||||||
updateMat (x, y) mat = newMat
|
updateMat (x, y) mat = newMat
|
||||||
@@ -148,10 +159,10 @@ updateMat (x, y) mat = newMat
|
|||||||
(colHead, _:colTail) = splitAt x row
|
(colHead, _:colTail) = splitAt x row
|
||||||
newMat = rowHead ++ [colHead ++ True : colTail] ++ rowTail
|
newMat = rowHead ++ [colHead ++ True : colTail] ++ rowTail
|
||||||
|
|
||||||
growMatDir :: Dir -> Mat -> Mat
|
growMatWire :: Wire -> Mat -> Mat
|
||||||
growMatDir dir mat
|
growMatWire wire mat
|
||||||
| dirMag dir == 0 = mat
|
| wireMag wire == 0 = mat
|
||||||
| otherwise = growMat (dirPair dir) mat
|
| otherwise = growMat (wirePair wire) mat
|
||||||
|
|
||||||
growMat :: (Int, Int) -> Mat -> Mat
|
growMat :: (Int, Int) -> Mat -> Mat
|
||||||
growMat (x, y) mat = growMatX x (growMatY y mat)
|
growMat (x, y) mat = growMatX x (growMatY y mat)
|
||||||
|
|||||||
Reference in New Issue
Block a user