@@ 49,6 49,10 @@ inBounds (Grid _ ((minX, minY),(maxX, maxY))) (x,y) =
bounds :: Grid a -> (Pos, Pos)
bounds (Grid _ b) = b
+renderGrid :: Grid a -> (Maybe a -> Char) -> String
+renderGrid (Grid m ((minX, minY),(maxX, maxY))) r =
+ concat $ [[ r $ Map.lookup (x,y) m | x <-[minX..maxX] ] ++ "\n" | y <- [minY..maxY] ]
+
type Parse = Grid Rock
parser :: Parser Parse
parser = parseGrid rock
@@ 56,30 60,66 @@ parser = parseGrid rock
<|> char '#' $> Just Cube
<|> char 'O' $> Just Round
-tiltNorth :: Grid Rock -> Pos -> Int
-tiltNorth g (x,y) =
- let (_, (_, mY)) = bounds g in
- mY - f 0 (pred y)
+roundRocks :: Grid Rock -> [Pos]
+roundRocks (Grid rs _) = Map.foldlWithKey f [] rs
+ where f acc p Round = p:acc
+ f acc _ Cube = acc
+
+north :: Grid Rock -> Pos -> Pos
+north g (x,y) = (x, succ $ f 0 (pred y))
where f acc 0 = acc
f acc y = case lookupGrid g (x,y) of
Nothing -> f acc (pred y)
Just Cube -> y + acc
Just Round -> f (succ acc) (pred y)
-roundRocks :: Grid Rock -> [Pos]
-roundRocks (Grid rs _) = Map.foldlWithKey f [] rs
- where f acc p Round = p:acc
- f acc _ Cube = acc
+east :: Grid Rock -> Pos -> Pos
+east g@(Grid _ (_, (mX, _))) (x,y) = (pred $ f 0 (succ x), y)
+ where f acc x | x > mX = succ $ mX - acc
+ f acc x | otherwise = case lookupGrid g (x,y) of
+ Nothing -> f acc (succ x)
+ Just Cube -> x - acc
+ Just Round -> f (succ acc) (succ x)
+
+south :: Grid Rock -> Pos -> Pos
+south g@(Grid _ (_, (_, mY))) (x,y) = (x, pred $ f 0 (succ y))
+ where f acc y | y > mY = succ $ mY - acc
+ f acc y | otherwise = case lookupGrid g (x,y) of
+ Nothing -> f acc (succ y)
+ Just Cube -> y - acc
+ Just Round -> f (succ acc) (succ y)
+
+west :: Grid Rock -> Pos -> Pos
+west g (x,y) = (succ $ f 0 (pred x), y)
+ where f acc 0 = acc
+ f acc x = case lookupGrid g (x,y) of
+ Nothing -> f acc (pred x)
+ Just Cube -> x + acc
+ Just Round -> f (succ acc) (pred x)
+
+tilt :: (Grid Rock -> Pos -> Pos) -> Grid Rock -> Grid Rock
+tilt t g@(Grid !rs b) = Grid (Map.foldlWithKey f Map.empty rs) b
+ where f rs' p Round = Map.insert (t g p) Round rs'
+ f rs' p Cube = Map.insert p Cube rs'
+
+load :: Grid Rock -> Int
+load g@(Grid _ (_, (_, mY))) = sum $ [ succ $ mY - y | (_, y) <- roundRocks g ]
partA :: Parse -> Int
-partA g = sum $ fmap (tiltNorth g) $ roundRocks g
+partA = load . tilt north
---partB :: Parse -> Parse
---partB = id
+partB :: Parse -> Int
+partB = f 0
+ where r Nothing = '.'
+ r (Just Cube) = '#'
+ r (Just Round) = 'O'
+ f n g | n == 1000000000 = load g
+ f n g | otherwise = f (succ n) (cycle g)
+ cycle = tilt east . tilt south . tilt west . tilt north
main :: IO ()
main = with parser $ do
run' "14.example" "a example" partA 136
run' "14.input" "a input" partA 106378
- --run "14.example" "b example" partB
+ run "14.example" "b example" partB
--run "14.input" "b input" partB