From 549425defbc1482abcef0e926094f0817842a4f5 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Tue, 3 Jan 2023 15:14:57 +0000 Subject: [PATCH] Added HashSet implementation --- advent-of-code22.cabal | 5 + advent23/Main.hs | 15 ++- advent23/MainUnordered.hs | 221 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 236 insertions(+), 5 deletions(-) create mode 100644 advent23/MainUnordered.hs diff --git a/advent-of-code22.cabal b/advent-of-code22.cabal index 24f58ef..5a5315d 100644 --- a/advent-of-code22.cabal +++ b/advent-of-code22.cabal @@ -246,6 +246,11 @@ executable advent23original main-is: advent23/MainOriginal.hs build-depends: containers, linear, lens, mtl, multiset +executable advent23u + import: common-extensions, build-directives + main-is: advent23/MainUnordered.hs + build-depends: unordered-containers, hashable, linear, lens, mtl, multiset + executable advent23 import: common-extensions, build-directives main-is: advent23/Main.hs diff --git a/advent23/Main.hs b/advent23/Main.hs index 08eef6c..e604a96 100644 --- a/advent23/Main.hs +++ b/advent23/Main.hs @@ -9,6 +9,7 @@ import Data.Monoid import Control.Monad.State.Strict import Control.Monad.ST import qualified Data.Array.IArray as A +import Data.Array.IArray ((!)) import qualified Data.Array.MArray as M import Data.Array.ST import Data.Maybe @@ -73,6 +74,13 @@ simulateN n = simulateN (n - 1) simulateOnce = + do updateGrove + growGrove + updateDirections + updateCount + +updateGrove :: GroveState () +updateGrove = do grove <- gets currentGrove proposalsInf <- gets proposalDirections let proposals = take 4 proposalsInf @@ -85,9 +93,6 @@ simulateOnce = moveElves mPopulation return mPopulation modify' (\g -> g { currentGrove = newGrove}) - growGrove - updateDirections - updateCount growGrove = do grove <- gets currentGrove @@ -206,7 +211,7 @@ shrink grove findStrip stripDirection currentBounds where shiftBounds (b0, b1) (d0, d1) = (b0 ^+^ d0, b1 ^+^ d1) emptyStrip :: Population -> (Position, Position) -> Bool -emptyStrip grove strip = all isNothing $ fmap (grove A.!) $ range strip +emptyStrip grove strip = all isNothing $ fmap (grove !) $ range strip topStrip, bottomStrip, leftStrip, rightStrip :: (Position, Position) -> (Position, Position) topStrip (V2 minX _minY, V2 maxX maxY) = (V2 minX maxY, V2 maxX maxY) @@ -221,7 +226,7 @@ leftShrink = (V2 1 0, V2 0 0) rightShrink = (V2 0 0, V2 -1 0) countEmpty :: Population -> (Position, Position) -> Int -countEmpty grove bounds = length $ filter isNothing $ fmap (grove A.!) cells +countEmpty grove bounds = length $ filter isNothing $ fmap (grove !) cells where cells = range bounds -- Parse the input file diff --git a/advent23/MainUnordered.hs b/advent23/MainUnordered.hs new file mode 100644 index 0000000..a765b1a --- /dev/null +++ b/advent23/MainUnordered.hs @@ -0,0 +1,221 @@ +-- Writeup at https://work.njae.me.uk/2022/12/23/advent-of-code-2022-day-23/ + +-- import Debug.Trace + +import AoC +import qualified Data.HashSet as S +import Linear +import Control.Lens +import Data.Ix +import Data.Maybe +-- import Data.Char +import Data.Monoid +import Data.MultiSet as MS +import Control.Monad.State.Strict +import Data.Hashable + + +type Position = V2 Int -- r, c + +data Direction = North | South | West | East + deriving (Show, Eq, Ord, Enum, Bounded) + +data Elf = Elf { _current :: Position, _proposed :: Position} + -- deriving (Show, Eq, Ord) + -- deriving (Eq, Ord) +makeLenses ''Elf + +instance Show Elf where + show elf = "Elf {c= " ++ (show (elf ^. current)) + ++ ", p= " ++ (show (elf ^. proposed)) + ++ " -> " ++ (show (directionOfElf elf)) + ++ "}" + +instance Eq Elf where + e1 == e2 = (_current e1) == (_current e2) + +instance Ord Elf where + e1 `compare` e2 = (_current e1) `compare` (_current e2) + +instance Hashable Elf where + hashWithSalt s e = hashWithSalt s (e ^. current) + +type Population = S.HashSet Elf + +data Grove = Grove { currentGrove :: Population, proposalDirections :: [Direction], elapsedRounds :: Int} + deriving (Eq) + +instance Show Grove where + show grove = (show $ currentGrove grove) ++ ", " ++ (show $ take 4 $ proposalDirections grove) ++ ", e = " ++ (show $ elapsedRounds grove) + +type GroveState = State Grove + + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + let grove = Grove (mkGrove text) (cycle [North .. East]) 0 + -- print grove + -- print $ execState simulateOnce grove + -- print $ execState (simulateN 4) grove + print $ part1 grove + print $ part2 grove + +part1, part2 :: Grove -> Int +part1 grove = countEmpty grove' bounds + where grove' = currentGrove $ execState (simulateN 10) grove + bounds = findBounds grove' + +part2 grove = elapsedRounds grove' + where grove' = execState simulateToCompletion grove + +directionOfElf :: Elf -> Maybe Direction +directionOfElf elf + | delta == V2 0 1 = Just North + | delta == V2 0 -1 = Just South + | delta == V2 1 0 = Just East + | delta == V2 -1 0 = Just West + | otherwise = Nothing + where delta = (elf ^. proposed) ^-^ (elf ^. current) + +simulateToCompletion, simulateOnce, proposeMoves, removeClashes, moveElves, updateDirections, updateCount :: GroveState () +simulateToCompletion = + do oldGrove <- gets currentGrove + simulateOnce + newGrove <- gets currentGrove + if oldGrove == newGrove + then return () + else simulateToCompletion + +simulateN :: Int -> GroveState () +simulateN 0 = return () +simulateN n = + do simulateOnce + simulateN (n - 1) + +simulateOnce = + do proposeMoves + removeClashes + moveElves + updateDirections + updateCount + +proposeMoves = + do grove <- gets currentGrove + proposalsInf <- gets proposalDirections + let proposals = take 4 proposalsInf + let grove' = S.map (makeProposal grove proposals) grove + modify' (\g -> g { currentGrove = grove'}) + +removeClashes = + do grove <- gets currentGrove + let clashes = findClashes grove + stopClashingElves clashes + +moveElves = + do grove <- gets currentGrove + let grove' = S.map moveElf grove + modify' (\g -> g { currentGrove = grove'}) + +updateDirections = modify' (\g -> g { proposalDirections = tail (proposalDirections g)}) +updateCount = modify' (\g -> g { elapsedRounds = (elapsedRounds g) + 1}) + +-- position changing utilities + +anyNeighbour :: S.HashSet Position +anyNeighbour = S.fromList [ V2 dx dy + | dx <- [-1, 0, 1] + , dy <- [-1, 0, 1] + , not ((dx == 0) && (dy == 0)) + ] + +directionNeighbour :: Direction -> S.HashSet Position +directionNeighbour North = S.filter (\d -> d ^. _y == 1) anyNeighbour +directionNeighbour South = S.filter (\d -> d ^. _y == -1) anyNeighbour +directionNeighbour West = S.filter (\d -> d ^. _x == -1) anyNeighbour +directionNeighbour East = S.filter (\d -> d ^. _x == 1) anyNeighbour + +stepDelta :: Direction -> Position +stepDelta North = V2 0 1 +stepDelta South = V2 0 -1 +stepDelta West = V2 -1 0 +stepDelta East = V2 1 0 + +translateTo :: Position -> S.HashSet Position -> S.HashSet Position +translateTo here deltas = S.map (here ^+^) deltas + +noElves :: Population -> S.HashSet Position -> Bool +noElves elves tests = S.null $ S.intersection tests $ S.map _current elves + +-- get elves to make proposals + +isolated :: Population -> Elf -> Bool +isolated elves elf = noElves elves $ translateTo (elf ^. current) $ anyNeighbour + +nearby :: Population -> Elf -> Population +nearby elves elf = S.filter (\e -> (e ^. current) `S.member` nbrs) elves + where nbrs = translateTo (elf ^. current) $ anyNeighbour + +makeProposal :: Population -> [Direction] -> Elf -> Elf +makeProposal grove directions elf + | isolated localElves elf = elf + | otherwise = fromMaybe elf $ getFirst $ mconcat $ fmap First $ fmap (proposedStep localElves elf) directions + where localElves = nearby grove elf + +proposedStep :: Population -> Elf -> Direction -> Maybe Elf +proposedStep grove elf direction + | noElves grove interfering = Just $ elf & proposed .~ (here ^+^ (stepDelta direction)) + | otherwise = Nothing + where here = elf ^. current + interfering = translateTo here $ directionNeighbour direction + +-- find clashing elves and prevent them moving + +findClashes :: Population -> S.HashSet Position +findClashes grove = S.fromList $ MS.distinctElems $ MS.foldOccur ifMany MS.empty targets + where targets = MS.map _proposed $ MS.fromList $ S.toList grove + ifMany t n s + | n == 1 = s + | otherwise = MS.insert t s + +stopClashingElves :: S.HashSet Position -> GroveState () +stopClashingElves clashes = + do grove <- gets currentGrove + let grove' = S.map (notClash clashes) grove + modify' (\g -> g { currentGrove = grove'}) + +notClash :: S.HashSet Position -> Elf -> Elf +notClash clashes elf + | (elf ^. proposed) `S.member` clashes = elf & proposed .~ (elf ^. current) + | otherwise = elf + +-- the elves move + +moveElf :: Elf -> Elf +moveElf elf = elf & current .~ (elf ^. proposed) + +-- part 1 solution utilities + +findBounds :: Population -> (Position, Position) +findBounds grove = ((V2 minX minY), (V2 maxX maxY)) + where minX = fromJust $ minimumOf (folded . current . _x) grove + minY = fromJust $ minimumOf (folded . current . _y) grove + maxX = fromJust $ maximumOf (folded . current . _x) grove + maxY = fromJust $ maximumOf (folded . current . _y) grove + +countEmpty :: Population -> (Position, Position) -> Int +countEmpty grove bounds = (rangeSize bounds) - (S.size grove) + +-- Parse the input file + +mkGrove :: String -> Population +mkGrove text = S.fromList + [ Elf (V2 x y) (V2 x y) + | x <- [0..maxX], y <- [0..maxY] + , isElf x y + ] + where rows = reverse $ lines text + maxY = length rows - 1 + maxX = (length $ head rows) - 1 + isElf x y = ((rows !! y) !! x) == '#' -- 2.34.1