51 lines
1.4 KiB
Haskell
51 lines
1.4 KiB
Haskell
import Control.Arrow
|
|
import Control.Lens
|
|
import qualified Data.Map as M
|
|
import Linear.V2
|
|
import Safe
|
|
|
|
type Grid = M.Map (V2 Int) Char
|
|
|
|
main :: IO ()
|
|
main = interact $ show . day14 . parse . lines
|
|
|
|
day14 :: Grid -> Int
|
|
day14 m =
|
|
sum $ map ((maxY -) . view _y . fst) (M.toList $ M.filter (== 'O') (moveAll m))
|
|
where maxY = succ $ maximum $ map (view _y) $ M.keys m
|
|
|
|
moveAll :: Grid -> Grid
|
|
moveAll m = foldl moveUp m os
|
|
where
|
|
os = map fst $ M.toList $ M.filter (== 'O') m
|
|
|
|
parse :: [String] -> Grid
|
|
parse = M.fromList . concat . zipWith (map . f) [0 ..] . map (zip [0 ..])
|
|
where
|
|
f x (y, z) = (V2 y x, z)
|
|
|
|
unParse :: Grid -> String
|
|
unParse m =
|
|
concat
|
|
[ M.elems (M.filterWithKey (\(V2 _ x) _ -> x == n) m) ++ "\n"
|
|
| n <- [a .. b]
|
|
]
|
|
where
|
|
(a, b) = (minimum &&& maximum) $ map (view _y) $ M.keys m
|
|
|
|
findLetter :: Char -> Grid -> V2 Int
|
|
findLetter c = fst . head . filter ((== c) . snd) . M.toList
|
|
|
|
filterLowestDot :: V2 Int -> V2 Int -> Char -> Bool
|
|
filterLowestDot (V2 x1 y1) (V2 x2 y2) c = c /= 'O' && x1 == x2 && y1 > y2
|
|
|
|
moveUp :: Grid -> V2 Int -> Grid
|
|
moveUp m k = swapCoord m newCoord k
|
|
where
|
|
line = M.toList $ M.filterWithKey (filterLowestDot k) m
|
|
newCoord = lastMay $ takeWhile (\x -> snd x /= '#') $ reverse line
|
|
|
|
swapCoord :: Grid -> Maybe (V2 Int, Char) -> V2 Int -> Grid
|
|
swapCoord m Nothing _ = m
|
|
swapCoord m (Just (v2, c)) v1 = M.insert v1 c $ M.insert v2 (m M.! v1) m
|