natto1784/AoC2022
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

day 14: random update

Browse Source 
Signed-off-by: Amneesh Singh <natto@weirdnatto.in>
This commit is contained in:
Amneesh Singh
2022-12-15 14:53:35 +05:30
parent b2881bf9a3
commit e7ad25a79d
1 changed files with 26 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
day14.hs
View File

@@ -3,41 +3,40 @@
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Set (Set) 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 Data.Text (Text)
import qualified Data.Text as T (lines, splitOn, words) import qualified Data.Text as T (lines, splitOn, words)
import qualified Data.Text.Read as T (decimal) import qualified Data.Text.Read as T (decimal)
import Lib (readFile') import Lib (readFile')
-- times can be improved greatly using Data.HashSet in unordered-containers, but i wont use it
-- ok this is it, this takes 4.54s, kms
-- this can probably be improved using hashtables in ST monad but will try that later
main :: IO () main :: IO ()
main = do main = do
input <- parse . T.lines <$> readFile' "day14.in" input <- parse . T.lines <$> readFile' "day14.in"
let mx = fst . fromJust $ S.lookupMax input let mx = maximum $ S.map snd input
putStr "Q1: " putStr "Q1: "
print $ sand (0, 500) input 0 mx Q1 print $ sand (500, 0) input 0 mx Q1
putStr "Q2: " 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) data Q = Q1 | Q2 deriving (Eq)
sand :: (Int, Int) -> Set (Int, Int) -> Int -> Int -> Q -> Int sand :: Coord -> Set Coord -> Int -> Int -> Q -> Int
sand (y, x) rocks soFar mx q sand (x, y) rocks soFar mx q
| (q == Q1 && y > mx) || S.member (y, x) rocks = soFar | (q == Q1 && y > mx) || S.member (x, y) rocks = soFar
| q == Q2 && y + 1 == mx = sand (0, 500) (S.insert (y, x) rocks) (soFar + 1) mx q | q == Q2 && y + 1 == mx = sand (500, 0) (S.insert (x, y) rocks) (soFar + 1) mx q
| S.notMember (y + 1, x) rocks = sand (y + 1, x) rocks soFar mx q | S.notMember (x, y + 1) rocks = sand (x, y + 1) rocks soFar mx q
| S.notMember (y + 1, x - 1) rocks = sand (y + 1, x - 1) rocks soFar mx q | S.notMember (x - 1, y + 1) rocks = sand (x - 1, y + 1) rocks soFar mx q
| S.notMember (y + 1, x + 1) rocks = sand (y + 1, x + 1) rocks soFar mx q | S.notMember (x + 1, y + 1) rocks = sand (x + 1, y + 1) rocks soFar mx q
| otherwise = sand (0, 500) (S.insert (y, x) rocks) (soFar + 1) 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 = parse =
S.fromList S.fromList
. concat . concatMap
. map
( ranges ( ranges
. map . map
( (\[x, y] -> (x, y)) ( (\[x, y] -> (x, y))
@@ -48,14 +47,13 @@ parse =
. T.words . T.words
) )
where where
ranges :: [(Int, Int)] -> [(Int, Int)] ranges :: [Coord] -> [Coord]
ranges xs = ranges xs =
concat $ foldr
foldr ( \((a, b), (x, y)) z ->
( \((a, b), (x, y)) z -> if a == x
if a == x then zip (repeat a) [min b y .. max b y] ++ z
then zip [min b y .. max b y] (repeat a) : z else zip [min a x .. max a x] (repeat b) ++ z
else zip (repeat b) [min a x .. max a x] : z )
) []
[] (zip xs (tail xs))
(zip xs (tail xs))