Day14: Part 2

day14.hs

@@ -1,13 +1,12 @@
 import Control.Monad
 
-data Entry = Air | SandProduce | SandFalling | SandRest | Rock deriving Eq
+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
@@ -37,7 +36,7 @@ max_x, max_y :: Path -> Int
 max_x = maximum.concatMap getXs
 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)
                                 my = maximum (map max_y paths)
 
@@ -51,18 +50,12 @@ 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'
-
+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
@@ -77,23 +70,28 @@ nextSquare (x,y) 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
+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 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
+sandStep stepper grid = do
+  newPoint <- stepper (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
+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