X-Git-Url: https://git.njae.me.uk/?p=advent-of-code-22.git;a=blobdiff_plain;f=advent23%2FMainOriginal.hs;fp=advent23%2FMainOriginal.hs;h=6296489eed97dfe4b6ae249149c51014420fdd47;hp=0000000000000000000000000000000000000000;hb=c96b3e327eb7f937787e9ac846d8f7c354bfa4a1;hpb=74302040c3188f5306aee7b438094f11652a11f8

diff --git a/advent23/MainOriginal.hs b/advent23/MainOriginal.hs
new file mode 100644
index 0000000..6296489
--- /dev/null
+++ b/advent23/MainOriginal.hs
@@ -0,0 +1,217 @@
+-- Writeup at https://work.njae.me.uk/2022/12/23/advent-of-code-2022-day-23/
+
+-- import Debug.Trace
+
+import AoC
+import qualified Data.Set 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
+
+
+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)
+
+type Population = S.Set 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.Set Position
+anyNeighbour = S.fromList [ V2 dx dy 
+                          | dx <- [-1, 0, 1]
+                          , dy <- [-1, 0, 1]
+                          , not ((dx == 0) && (dy == 0))
+                          ]
+
+directionNeighbour :: Direction -> S.Set 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.Set Position -> S.Set Position
+translateTo here deltas = S.map (here ^+^) deltas
+
+noElves :: Population -> S.Set 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.Set Position
+findClashes grove = MS.toSet $ MS.foldOccur ifMany MS.empty targets
+  where targets = MS.map _proposed $ MS.fromSet grove
+        ifMany t n s 
+          | n == 1 = s
+          | otherwise = MS.insert t s
+
+stopClashingElves :: S.Set Position -> GroveState ()
+stopClashingElves clashes =
+  do grove <- gets currentGrove
+     let grove' = S.map (notClash clashes) grove
+     modify' (\g -> g { currentGrove = grove'})
+
+notClash :: S.Set 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) == '#'