Initial commit with Day 1, 2 and part of 3
Signed-off-by: Alek Ratzloff <alekratz@gmail.com>
This commit is contained in:
173
day03/Day03.hs
Normal file
173
day03/Day03.hs
Normal file
@@ -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
|
||||
162
day03/Day03.old.hs
Normal file
162
day03/Day03.old.hs
Normal file
@@ -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)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user