99 lines
3.1 KiB
Haskell
99 lines
3.1 KiB
Haskell
import Control.Monad
|
|
|
|
data Entry = Air | SandProduce | SandFalling | 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+5) (my+2)
|
|
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)
|
|
|
|
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)
|
|
|
|
-- sandStep grid = let ((x,y) = nextSquare (500,0) grid in drawPoint SandRest grid (x,y)
|
|
sandStep :: Grid -> Maybe Grid
|
|
sandStep grid = do
|
|
newPoint <- nextSquare (500,0) grid
|
|
pure $ drawPoint SandRest grid newPoint
|
|
|
|
doStep n grid
|
|
| (Just grid')<-sandStep grid = doStep (n+1) grid'
|
|
| otherwise = n
|
|
|
|
short = readFile "day14short" >>= (\paths -> pure$drawInput (minGridFromInput paths) paths).map parsePath.lines
|
|
long = readFile "day14long" >>= (\paths -> pure$drawInput (minGridFromInput paths) paths).map parsePath.lines
|
|
|