From e7ad25a79dad23d4999c970ae44efdc12f6f380c Mon Sep 17 00:00:00 2001 From: Amneesh Singh Date: Thu, 15 Dec 2022 14:53:35 +0530 Subject: [PATCH] day 14: random update Signed-off-by: Amneesh Singh --- day14.hs | 54 ++++++++++++++++++++++++++---------------------------- 1 file changed, 26 insertions(+), 28 deletions(-) diff --git a/day14.hs b/day14.hs index ba2355c..b9f5e95 100644 --- a/day14.hs +++ b/day14.hs @@ -3,41 +3,40 @@ import Data.Maybe (fromJust) import Data.Set (Set) -import qualified Data.Set as S (fromList, insert, lookupMax, member, notMember, union) +import qualified Data.Set as S (fromList, insert, map, member, notMember, union) import Data.Text (Text) import qualified Data.Text as T (lines, splitOn, words) import qualified Data.Text.Read as T (decimal) import Lib (readFile') - --- ok this is it, this takes 4.54s, kms --- this can probably be improved using hashtables in ST monad but will try that later +-- times can be improved greatly using Data.HashSet in unordered-containers, but i wont use it main :: IO () main = do input <- parse . T.lines <$> readFile' "day14.in" - let mx = fst . fromJust $ S.lookupMax input + let mx = maximum $ S.map snd input putStr "Q1: " - print $ sand (0, 500) input 0 mx Q1 + print $ sand (500, 0) input 0 mx Q1 putStr "Q2: " - print $ sand (0, 500) input 0 (mx + 2) Q2 + print $ sand (500, 0) input 0 (mx + 2) Q2 + +type Coord = (Int, Int) data Q = Q1 | Q2 deriving (Eq) -sand :: (Int, Int) -> Set (Int, Int) -> Int -> Int -> Q -> Int -sand (y, x) rocks soFar mx q - | (q == Q1 && y > mx) || S.member (y, x) rocks = soFar - | q == Q2 && y + 1 == mx = sand (0, 500) (S.insert (y, x) rocks) (soFar + 1) mx q - | S.notMember (y + 1, x) rocks = sand (y + 1, x) rocks soFar mx q - | S.notMember (y + 1, x - 1) rocks = sand (y + 1, x - 1) rocks soFar mx q - | S.notMember (y + 1, x + 1) rocks = sand (y + 1, x + 1) rocks soFar mx q - | otherwise = sand (0, 500) (S.insert (y, x) rocks) (soFar + 1) mx q +sand :: Coord -> Set Coord -> Int -> Int -> Q -> Int +sand (x, y) rocks soFar mx q + | (q == Q1 && y > mx) || S.member (x, y) rocks = soFar + | q == Q2 && y + 1 == mx = sand (500, 0) (S.insert (x, y) rocks) (soFar + 1) mx q + | S.notMember (x, y + 1) rocks = sand (x, y + 1) rocks soFar mx q + | S.notMember (x - 1, y + 1) rocks = sand (x - 1, y + 1) rocks soFar mx q + | S.notMember (x + 1, y + 1) rocks = sand (x + 1, y + 1) rocks soFar mx q + | otherwise = sand (500, 0) (S.insert (x, y) rocks) (soFar + 1) mx q -parse :: [Text] -> Set (Int, Int) +parse :: [Text] -> Set Coord parse = S.fromList - . concat - . map + . concatMap ( ranges . map ( (\[x, y] -> (x, y)) @@ -48,14 +47,13 @@ parse = . T.words ) where - ranges :: [(Int, Int)] -> [(Int, Int)] + ranges :: [Coord] -> [Coord] ranges xs = - concat $ - foldr - ( \((a, b), (x, y)) z -> - if a == x - then zip [min b y .. max b y] (repeat a) : z - else zip (repeat b) [min a x .. max a x] : z - ) - [] - (zip xs (tail xs)) + foldr + ( \((a, b), (x, y)) z -> + if a == x + then zip (repeat a) [min b y .. max b y] ++ z + else zip [min a x .. max a x] (repeat b) ++ z + ) + [] + (zip xs (tail xs))