Added HashSet implementation
authorNeil Smith <NeilNjae@users.noreply.github.com>
Tue, 3 Jan 2023 15:14:57 +0000 (15:14 +0000)
committerNeil Smith <NeilNjae@users.noreply.github.com>
Tue, 3 Jan 2023 15:14:57 +0000 (15:14 +0000)
advent-of-code22.cabal
advent23/Main.hs
advent23/MainUnordered.hs [new file with mode: 0644]

index 24f58ef4cdbed8b918d1258ebdc66fa06236f56d..5a5315da9d503c3ac3eb6a676e9454c160f7885d 100644 (file)
@@ -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
index 08eef6c6f4f07c0970322e1d0ba74fbb44004a33..e604a965de616a869b73a168c092fb2a6e04f898 100644 (file)
@@ -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 (file)
index 0000000..a765b1a
--- /dev/null
@@ -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) == '#'