christofsteel/aoc2022
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Day14: Part 2

Browse source
This commit is contained in:
Christoph Stahl 2022-12-14 16:36:01 +01:00
parent 3cd5c1c026
commit 5b2b7f3ba4
1 changed files with 23 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
day14.hs
View file

@ -1,13 +1,12 @@
import Control.Monad import Control.Monad
data Entry = Air | SandProduce | SandFalling | SandRest | Rock deriving Eq data Entry = Air | SandProduce | SandRest | Rock deriving Eq
type Grid = [[Entry]] type Grid = [[Entry]]
type Position = (Int, Int) type Position = (Int, Int)
type Line = (Position, Position) type Line = (Position, Position)
type Path = [Line] type Path = [Line]
drawPoint :: Entry -> Grid -> Position -> Grid drawPoint :: Entry -> Grid -> Position -> Grid
drawPoint e grid (x,y) = linesBefore++(entriesBefore++e:entriesAfter):linesAfter drawPoint e grid (x,y) = linesBefore++(entriesBefore++e:entriesAfter):linesAfter
where (linesBefore,line:linesAfter) = splitAt y grid where (linesBefore,line:linesAfter) = splitAt y grid
@ -37,7 +36,7 @@ max_x, max_y :: Path -> Int
max_x = maximum.concatMap getXs max_x = maximum.concatMap getXs
max_y = maximum.concatMap getYs max_y = maximum.concatMap getYs
minGridFromInput paths = startGrid (mx+5) (my+2) minGridFromInput paths = startGrid (mx+my) (my+3)
where mx = maximum (map max_x paths) where mx = maximum (map max_x paths)
my = maximum (map max_y paths) my = maximum (map max_y paths)
@ -51,18 +50,12 @@ parseLine (x,y) = (parsePosition x,parsePosition y)
parsePath line = let w = words line in parsePath line = let w = words line in
map parseLine $ filter(/=("->","->")) $ zip w (drop 2 w) map parseLine $ filter(/=("->","->")) $ zip w (drop 2 w)
entryToChar Air = '.' entryToChar Air = '.';entryToChar Rock = '#';entryToChar SandProduce = '+';entryToChar SandFalling = '~';entryToChar SandRest = 'o'
entryToChar Rock = '#'
entryToChar SandProduce = '+'
entryToChar SandFalling = '~'
entryToChar SandRest = 'o'
printLine startx endx line = do printLine startx endx line = do
let line' = take (endx - startx + 1) $ drop startx line let line' = take (endx - startx + 1) $ drop startx line
forM line' (putChar.entryToChar) forM line' (putChar.entryToChar)
putChar '\n' putChar '\n'
printGrid (startx,starty) (endx, endy) grid = do printGrid (startx,starty) (endx, endy) grid = do
let grid' = take (endy - starty + 1) $ drop starty grid let grid' = take (endy - starty + 1) $ drop starty grid
@ -77,23 +70,28 @@ nextSquare (x,y) grid
| isAir (x+1,y+1) grid = nextSquare (x+1,y+1) grid | isAir (x+1,y+1) grid = nextSquare (x+1,y+1) grid
| otherwise = Just (x,y) | otherwise = Just (x,y)
nextSquare (x,y) grid nextSquare2 (x,y) grid
| (y+1) >= length grid = Nothing | isAir (x,y+1) grid = nextSquare2 (x,y+1) grid
| isAir (x,y+1) grid = nextSquare (x,y+1) grid | isAir (x-1,y+1) grid = nextSquare2 (x-1,y+1) grid
| isAir (x-1,y+1) grid = nextSquare (x-1,y+1) grid | isAir (x+1,y+1) grid = nextSquare2 (x+1,y+1) grid
| isAir (x+1,y+1) grid = nextSquare (x+1,y+1) grid | (x,y) == (500,0) = Nothing
| otherwise = Just (x,y) | otherwise = Just (x,y)
-- sandStep grid = let ((x,y) = nextSquare (500,0) grid in drawPoint SandRest grid (x,y) sandStep stepper grid = do
sandStep :: Grid -> Maybe Grid newPoint <- stepper (500,0) grid
sandStep grid = do
newPoint <- nextSquare (500,0) grid
pure $ drawPoint SandRest grid newPoint pure $ drawPoint SandRest grid newPoint
doStep n grid doStep f n grid
| (Just grid')<-sandStep grid = doStep (n+1) grid' | (Just grid')<-sandStep f grid = doStep f (n+1) grid'
| otherwise = n | otherwise = (n, grid)
short = readFile "day14short" >>= (\paths -> pure$drawInput (minGridFromInput paths) paths).map parsePath.lines
long = readFile "day14long" >>= (\paths -> pure$drawInput (minGridFromInput paths) paths).map parsePath.lines
main = do
grid <- readFile "day14long" >>= (\paths -> pure$drawInput (minGridFromInput paths) paths).map parsePath.lines
let height = length grid
let width = length (grid!!0)
let grid2 = drawLine grid ((0,height-1),(width-1,height-1))
let (n1,g1) = doStep nextSquare 0 grid
let (n2,g2) = doStep nextSquare2 0 grid2
print n1
print $ 1+n2
-- printGrid (460,0) (width-1, height-1) g2