97 lines
3.1 KiB
Haskell
97 lines
3.1 KiB
Haskell
import Control.Monad
|
|
|
|
data Entry = Air | SandProduce | SandRest | Rock deriving Eq
|
|
|
|
type Grid = [[Entry]]
|
|
type Position = (Int, Int)
|
|
type Line = (Position, Position)
|
|
type Path = [Line]
|
|
|
|
drawPoint :: Entry -> Grid -> Position -> Grid
|
|
drawPoint e grid (x,y) = linesBefore++(entriesBefore++e:entriesAfter):linesAfter
|
|
where (linesBefore,line:linesAfter) = splitAt y grid
|
|
(entriesBefore, _:entriesAfter) = splitAt x line
|
|
|
|
range :: Int -> Int -> [Int]
|
|
range a b
|
|
| a <= b = [a..b]
|
|
| otherwise = range b a
|
|
|
|
drawLine :: Grid -> Line -> Grid
|
|
drawLine grid (from, to)
|
|
| fst from == fst to = foldl (drawPoint Rock) grid [(fst from,y) | y<-range (snd from) (snd to)]
|
|
| otherwise = foldl (drawPoint Rock) grid [(x, snd from) | x<-range (fst from) (fst to)]
|
|
|
|
drawPath :: Grid -> Path -> Grid
|
|
drawPath = foldl drawLine
|
|
|
|
drawInput :: Grid -> [Path] -> Grid
|
|
drawInput = foldl drawPath
|
|
|
|
getXs, getYs :: Line -> [Int]
|
|
getXs ((x,_),(x',_)) = [x,x']
|
|
getYs ((_,y),(_,y')) = [y,y']
|
|
|
|
max_x, max_y :: Path -> Int
|
|
max_x = maximum.concatMap getXs
|
|
max_y = maximum.concatMap getYs
|
|
|
|
minGridFromInput paths = startGrid (mx+my) (my+3)
|
|
where mx = maximum (map max_x paths)
|
|
my = maximum (map max_y paths)
|
|
|
|
startGrid width height = drawPoint SandProduce [[ Air | _<-[1..width]] | _ <- [1..height]] (500,0)
|
|
|
|
parsePosition :: String -> Position
|
|
parsePosition stringPosition = read $ '(':stringPosition ++ ")"
|
|
|
|
parseLine (x,y) = (parsePosition x,parsePosition y)
|
|
|
|
parsePath line = let w = words line in
|
|
map parseLine $ filter(/=("->","->")) $ zip w (drop 2 w)
|
|
|
|
entryToChar Air = '.';entryToChar Rock = '#';entryToChar SandProduce = '+';entryToChar SandFalling = '~';entryToChar SandRest = 'o'
|
|
|
|
printLine startx endx line = do
|
|
let line' = take (endx - startx + 1) $ drop startx line
|
|
forM line' (putChar.entryToChar)
|
|
putChar '\n'
|
|
|
|
printGrid (startx,starty) (endx, endy) grid = do
|
|
let grid' = take (endy - starty + 1) $ drop starty grid
|
|
forM grid' $ printLine startx endx
|
|
|
|
isAir (x,y) grid = grid !! y !! x == Air
|
|
|
|
nextSquare (x,y) grid
|
|
| (y+1) >= length grid = Nothing
|
|
| isAir (x,y+1) grid = nextSquare (x,y+1) 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)
|
|
|
|
nextSquare2 (x,y) grid
|
|
| isAir (x,y+1) grid = nextSquare2 (x,y+1) grid
|
|
| isAir (x-1,y+1) grid = nextSquare2 (x-1,y+1) grid
|
|
| isAir (x+1,y+1) grid = nextSquare2 (x+1,y+1) grid
|
|
| (x,y) == (500,0) = Nothing
|
|
| otherwise = Just (x,y)
|
|
|
|
sandStep stepper grid = do
|
|
newPoint <- stepper (500,0) grid
|
|
pure $ drawPoint SandRest grid newPoint
|
|
|
|
doStep f n grid
|
|
| (Just grid')<-sandStep f grid = doStep f (n+1) grid'
|
|
| otherwise = (n, grid)
|
|
|
|
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
|