From 40e620e4c9007804fb2a06411f004a45bac3c30b Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Wed, 19 Dec 2018 14:17:57 +0000 Subject: [PATCH] Finally done day 15 --- src/advent15/advent15.hs | 331 +++++++++++++++++++++------------------ 1 file changed, 182 insertions(+), 149 deletions(-) diff --git a/src/advent15/advent15.hs b/src/advent15/advent15.hs index 9c54e04..00576f6 100644 --- a/src/advent15/advent15.hs +++ b/src/advent15/advent15.hs @@ -1,16 +1,10 @@ import Data.List --- import Data.Tuple (swap) +import Data.Tuple (swap) import Data.Maybe -import qualified Data.Foldable -import Data.Foldable (forM_) +-- import Data.Foldable (forM_) import qualified Data.Map.Strict as M import Data.Map.Strict ((!)) import qualified Data.Set as S -import qualified Data.PQueue.Prio.Min as P -import qualified Data.Sequence as Q -import Data.Sequence ((|>), (<|), Seq (Empty, (:<|), (:|>))) - -import Debug.Trace type Coord = (Int, Int) -- row, column type HitPoints = Int @@ -18,11 +12,7 @@ data Species = Elf | Goblin deriving (Show, Eq) data Agent = Agent Species HitPoints deriving (Show, Eq) type Agents = M.Map Coord Agent type Layout = S.Set Coord -type OrderedLayout = Q.Seq Coord - -type Closed = Layout -data Agendum = Agendum {_current :: Coord, _trail :: OrderedLayout, _cost :: Int} deriving (Show, Eq) -type Agenda = P.MinPQueue (Int, Int) Agendum +type Distances = M.Map Coord Int newGoblin = Agent Goblin 200 newElf = Agent Elf 200 @@ -41,62 +31,122 @@ elfs agents = M.filter isElf agents goblins :: Agents -> Agents goblins agents = M.filter isGoblin agents - - -test1 = "#######\n#E..G.#\n#...#.#\n#.G.#G#\n#######\n" -test2 = "#########\n#G..G..G#\n#.......#\n#.......#\n#G..E..G#\n#.......#\n#.......#\n#G..G..G#\n#########\n" -test3 = "#######\n#.G...#\n#...EG#\n#.#.#G#\n#..G#E#\n#.....#\n#######\n" +-- test1 = "#######\n#E..G.#\n#...#.#\n#.G.#G#\n#######\n" +-- test2 = "#########\n#G..G..G#\n#.......#\n#.......#\n#G..E..G#\n#.......#\n#.......#\n#G..G..G#\n#########\n" +-- test3 = "#######\n#.G...#\n#...EG#\n#.#.#G#\n#..G#E#\n#.....#\n#######\n" +-- test4 = "#######\n#G..#E#\n#E#E.E#\n#G.##.#\n#...#E#\n#...E.#\n#######\n" +-- test5 = "#######\n#E..EG#\n#.#G.E#\n#E.##E#\n#G..#.#\n#..E#.#\n#######\n" +-- test6 = "#######\n#E.G#.#\n#.#G..#\n#G.#.G#\n#G..#.#\n#...E.#\n#######\n" +-- test7 = "#######\n#.E...#\n#.#..G#\n#.###.#\n#E#G#G#\n#...#G#\n#######\n" +-- test8 = "#########\n#G......#\n#.E.#...#\n#..##..G#\n#...##..#\n#...#...#\n#.G...G.#\n#.....G.#\n#########\n" main :: IO () main = do text <- readFile "data/advent15.txt" - let (layout, agents) = parse test3 - -- print layout + let (layout, agents) = parse text + print $ part1 layout agents + print $ part2 layout agents + -- print layout -- print agents - putStrLn $ showWorld layout agents --- print $ pathsToEnemies (1, 1) layout agents + -- putStrLn $ showWorld layout agents + -- let game = runGame layout agents 15 + -- print $ length game + -- putStrLn $ showWorld layout $ snd $ last game + -- print $ last game + -- print $ length game - 1 + -- print $ scoreGame game + -- print $ wonWithoutLoss game + -- let game2 = runGame layout agents 14 + -- print $ length game2 + -- putStrLn $ showWorld layout $ snd $ last game2 + -- print $ last game2 + -- print $ length game2 - 1 + -- print $ scoreGame game2 + -- print $ wonWithoutLoss game2 + -- print $ bestMove (1, 1) layout agents -- let (h, e) = M.findMin $ elfs agents -- print (h, e) -- forM_ (M.assocs agents) $ \(ah, a) -> do -- print (ah, a) - -- print $ pathsToEnemies ah layout agents - -- print $ bestMove ah layout agents - let a1 = doNRounds 22 layout agents - putStrLn $ showWorld layout a1 - print a1 - let a2 = doRound layout a1 - putStrLn $ showWorld layout a2 - print a2 - let a3 = doRound layout a2 - putStrLn $ showWorld layout a3 - print a3 - let a4 = doRound layout a3 - putStrLn $ showWorld layout a4 - print a4 - let a5 = doRound layout a4 - putStrLn $ showWorld layout a5 - print a5 - let a6 = doRound layout a5 - putStrLn $ showWorld layout a6 - print a6 - - -showWorld layout agents = unlines rows - where rows = map (showRow layout agents) [minRow..maxRow] - minRow = fst $ S.findMin layout' - maxRow = fst $ S.findMax layout' - layout' = S.union layout $ S.fromList $ M.keys agents - -showRow layout agents row = map (\col -> showCell (row, col) layout agents) [minCol..maxCol] - where minCol = minimum $ map snd $ S.toList layout' - maxCol = maximum $ map snd $ S.toList layout' - layout' = S.union layout $ S.fromList $ M.keys agents - -showCell c layout agents = - if c `M.member` agents - then if isElf a then 'E' else 'G' - else if c `S.member` layout then '.' else '\x2593' - where a = agents!c + -- print $ pathsToEnemies ah layout agents + -- print $ bestMove ah layout agents + -- let a1 = doRound layout agents + -- let a0 = doRound layout agents + -- putStrLn $ "1\n" ++ showWorld layout a0 + -- print a0 + -- let n = 35 + -- let a1 = doNRounds n layout agents + -- putStrLn $ show n ++ "\n" ++ showWorld layout a1 + -- print a1 + -- let a2 = doRound layout a1 + -- putStrLn $ show (n+1) ++ "\n" ++ showWorld layout a2 + -- print a2 + -- let a3 = doRound layout a2 + -- putStrLn $ show (n+2) ++ "\n" ++ showWorld layout a3 + -- print a3 + -- let a4 = doRound layout a3 + -- putStrLn $ show (n+3) ++ "\n" ++ showWorld layout a4 + -- print a4 + -- let a5 = doRound layout a4 + -- putStrLn $ show (n+4) ++ "\n" ++ showWorld layout a5 + -- print a5 + + -- let a6 = doRound layout a5 + -- putStrLn $ "27\n" ++ showWorld layout a6 + -- print a6 + -- let a7 = doRound layout a6 + -- putStrLn $ "28\n" ++ showWorld layout a7 + -- print a7 + -- let a8 = doNRounds 19 layout a7 + -- putStrLn $ "47\n" ++ showWorld layout a8 + -- print a8 + -- let a9 = doRound layout a8 + -- putStrLn $ "30\n" ++ showWorld layout a9 + -- print a9 + -- let aa = doRound layout a9 + -- putStrLn $ "31\n" ++ showWorld layout aa + -- print aa + -- let ab = doRound layout aa + -- putStrLn $ "32\n" ++ showWorld layout ab + -- print ab + -- let ac = doRound layout ab + -- putStrLn $ "33\n" ++ showWorld layout ac + -- print ac + -- let ad = doRound layout ac + -- putStrLn $ "34\n" ++ showWorld layout ad + -- print ad + -- let ae = doRound layout ad + -- putStrLn $ "35\n" ++ showWorld layout ae + -- print ae + + +part1 layout agents = scoreGame $ runGame layout agents 3 + +part2 layout agents = runPart2 layout agents 4 + +runPart2 layout agents elfPower = + if wonWithoutLoss game + then (scoreGame game, elfPower) + else runPart2 layout agents (elfPower + 1) + where game = runGame layout agents elfPower + + +-- showWorld layout agents = unlines rows +-- where rows = map (showRow layout agents) [minRow..maxRow] +-- minRow = fst $ S.findMin layout' +-- maxRow = fst $ S.findMax layout' +-- layout' = S.union layout $ S.fromList $ M.keys agents + +-- showRow layout agents row = map (\col -> showCell (row, col) layout agents) [minCol..maxCol] +-- where minCol = minimum $ map snd $ S.toList layout' +-- maxCol = maximum $ map snd $ S.toList layout' +-- layout' = S.union layout $ S.fromList $ M.keys agents + +-- showCell c layout agents = +-- if c `M.member` agents +-- then if isElf a then 'E' else 'G' +-- else if c `S.member` layout then '.' else '\x2593' +-- where a = agents!c -- Parsing @@ -128,90 +178,52 @@ free here layout agents = (here `S.member` layout) && (here `M.notMember` agents adjacentFree :: Coord -> Layout -> Agents -> Layout adjacentFree here layout agents = S.filter (\c -> free c layout agents) (adjacent here layout) -orderedAdjacentFree :: Coord -> Layout -> Agents -> OrderedLayout -orderedAdjacentFree here layout agents = Q.sort $ S.foldl' (|>) Q.empty cells - where cells = adjacentFree here layout agents - - --- Searching - -initAgenda :: Coord -> Coord -> Agenda -initAgenda start goal = P.singleton ((estimateCost start goal), (fst start * 1000 + snd start)) Agendum {_current = start, _trail = Q.empty, _cost = 0} - -aStar :: Coord -> Layout -> Agents -> Agenda -> Closed -> Maybe Agendum -aStar goal layout agents agenda closed - -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined - | P.null agenda = Nothing - | otherwise = - if reached == goal then Just currentAgendum - else if reached `S.member` closed - then aStar goal layout agents (P.deleteMin agenda) closed - else aStar goal layout agents newAgenda closed' - where - (_, currentAgendum) = P.findMin agenda - reached = _current currentAgendum - closed' = S.insert reached closed - tieBreakerCost a = foldl' (\t (r, c) -> t + r * 1000 + c) 0 ((_current a) <| (_trail a)) - newAgenda = foldl' (\q a -> P.insert ((estimatedCost a), tieBreakerCost a) a q) (P.deleteMin agenda) $ candidates layout agents currentAgendum closed' - estimatedCost agendum = estimateCost reached goal + _cost agendum - -candidates :: Layout -> Agents -> Agendum -> Closed -> Q.Seq Agendum -candidates layout agents agendum closed = newCandidates - where - candidate = _current agendum - previous = _trail agendum - succs = orderedAdjacentFree candidate layout agents - nonloops = Q.filter (\s -> s `S.notMember` closed) succs - newCandidates = fmap (\n -> makeAgendum n) nonloops - makeAgendum new = Agendum { _current = new, - _trail = candidate <| previous, - _cost = _cost agendum + 1} - -estimateCost :: Coord -> Coord -> Int -estimateCost (r, c) (gr, gc) = abs (r - gr) + abs(c - gc) - -- Move selection -shortestDistanceTo :: Coord -> Coord -> Layout -> Agents -> Maybe (Int, OrderedLayout) -shortestDistanceTo here there layout agents = - if searchResult == Nothing +distancesFrom :: Coord -> Layout -> Agents -> Distances +distancesFrom here layout agents = distanceFlood layout agents [here] (M.singleton here 0) + +distanceFlood :: Layout -> Agents -> [Coord] -> Distances -> Distances +distanceFlood layout agents boundary distances + | null boundary = distances + | otherwise = distanceFlood layout agents newBoundary newDistances + where current = head boundary + currentCost = distances!current + neighbours = filter (\c -> c `M.notMember` distances) $ S.toList $ adjacentFree current layout agents + newDistances = foldl' (\m l -> M.insert l (currentCost + 1) m) distances neighbours + newBoundary = nub $ (tail boundary) ++ neighbours + + +shortestDistanceStepTo :: Coord -> Coord -> Layout -> Agents -> Maybe (Int, Coord) +shortestDistanceStepTo here there layout agents = + if M.null distanceSteps then Nothing - else Just (_cost $ fromJust searchResult, (_current $ fromJust searchResult) <| (_trail $ fromJust searchResult)) - where searchResult = aStar there layout agents (initAgenda here there) S.empty + else Just $ head $ sort $ map swap $ M.toList distanceSteps + where distances = distancesFrom there layout agents + steps = adjacentFree here layout agents + distanceSteps = M.filterWithKey (\k _ -> k `S.member` steps) distances -- S.map (\c -> (distances!c, c)) steps + +stepsTowardsEnemies :: Coord -> Layout -> Agents -> [(Int, Coord)] +stepsTowardsEnemies here layout agents = + catMaybes + $ map (\e -> shortestDistanceStepTo here e layout agents) + $ S.toList $ enemyLocations here agents enemyLocations :: Coord -> Agents -> Layout enemyLocations here agents = S.fromList $ M.keys $ M.filter (isSpecies enemySpecies) agents where Agent thisSpecies _ = agents!here enemySpecies = otherSpecies thisSpecies -agentTargets :: Coord -> Layout -> Agents -> Layout -agentTargets here layout agents = S.foldl S.union S.empty enemyAdjacents - where enemies = enemyLocations here agents - enemyAdjacents = S.map (\l -> adjacentFree l layout agents) enemies - -pathsToEnemies :: Coord -> Layout -> Agents -> [(Int, OrderedLayout)] -pathsToEnemies here layout agents = catMaybes $ map sdt $ S.toList targets - where sdt there = shortestDistanceTo here there layout agents - targets = agentTargets here layout agents - -closestEnemies :: Coord -> Layout -> Agents -> [OrderedLayout] -closestEnemies here layout agents = possibles - where paths = pathsToEnemies here layout agents - closest = minimum $ map fst paths - possibles = map snd $ filter (\p -> fst p == closest) paths - bestMove :: Coord -> Layout -> Agents -> Coord bestMove here layout agents = - if null paths + if null steps then here - else head $ sort $ map pathStep paths - where paths = closestEnemies here layout agents - pathStep p = if Q.length p > 1 then Q.index p (Q.length p - 2) else Q.index p 1 + else snd $ head $ sort $ steps + where steps = stepsTowardsEnemies here layout agents -makeBestMove :: Coord -> Layout -> Agents -> Agents -makeBestMove here layout agents = M.insert there agent $ M.delete here agents +makeMove :: Coord -> Coord -> Agents -> Agents +makeMove here there agents = M.insert there agent $ M.delete here agents where agent = agents!here - there = bestMove here layout agents -- Attacking @@ -219,43 +231,64 @@ bestTarget :: Coord -> Layout -> Agents -> Coord bestTarget here layout agents = keyOfMinHP $ M.filterWithKey (\c _ -> c `S.member` enemies) agents where enemies = touchingEnemies here layout agents -attack :: Coord -> Agents -> Agents -attack target agents = if hp > 3 - then M.insert target (Agent species (hp - 3)) agents +attack :: Coord -> Agents -> Int -> Agents +attack target agents elfPower = if hp > power + then M.insert target (Agent species (hp - power)) agents else M.delete target agents where Agent species hp = agents!target + power = if species == Goblin then elfPower else 3 keyOfMinHP :: Agents -> Coord -- Ord b => M.Map a b -> a keyOfMinHP m = fst $ M.foldrWithKey mergeKV (M.findMin m) m where mergeKV k (Agent s v) (bestK, (Agent sb bestV)) = if v < bestV then (k, (Agent s v)) else (bestK, (Agent sb bestV)) -makeAttack :: Coord -> Layout -> Agents -> Agents -makeAttack here layout agents = attack target agents +makeAttack :: Coord -> Layout -> Agents -> Int -> Agents +makeAttack here layout agents elfPower = attack target agents elfPower where target = bestTarget here layout agents -- Game loop -doNRounds :: Int -> Layout -> Agents -> Agents -doNRounds n layout agents - | n == 0 = agents - | otherwise = doNRounds (n-1) layout (doRound layout agents) +-- doNRounds :: Int -> Layout -> Agents -> Int -> Agents +-- doNRounds n layout agents elfPower +-- | n == 0 = agents +-- | otherwise = doNRounds (n-1) layout (snd $ doRound layout agents elfPower) elfPower -doRound :: Layout -> Agents -> Agents -doRound layout agents = agents' - -- where agents' = foldl' (\a h -> makeBestMove h layout a) agents $ M.keys agents - where agents' = foldl' (\a h -> agentAction h layout a) agents $ M.keys agents +doRound :: Layout -> Agents -> Int -> (Bool, Agents) +doRound layout agents elfPower = agents' + where agents' = foldl' (\(_, a) h -> agentAction h layout a elfPower) (True, agents) $ M.keys agents touchingEnemies :: Coord -> Layout -> Agents -> Layout touchingEnemies here layout agents = S.intersection neighbourhood enemies where neighbourhood = adjacent here layout enemies = enemyLocations here agents -agentAction :: Coord -> Layout -> Agents -> Agents -agentAction here layout agents - | here `M.member` agents = if S.null targets - then makeBestMove here layout agents - else makeAttack here layout agents - | otherwise = agents +agentAction :: Coord -> Layout -> Agents -> Int -> (Bool, Agents) +agentAction here layout agents elfPower + | (M.null (elfs agents)) || (M.null (goblins agents)) = (False, agents) + | here `M.notMember` agents = (True, agents) + | S.null $ enemyLocations here agents = (True, agents) + | otherwise = (True, agents'') where targets = touchingEnemies here layout agents + here' = if S.null targets + then bestMove here layout agents + else here + agents' = makeMove here here' agents + targets' = touchingEnemies here' layout agents' + agents'' = if S.null targets' + then agents' + else makeAttack here' layout agents' elfPower + +runGame :: Layout -> Agents -> Int -> [(Bool, Agents)] +runGame layout agents elfPower = states ++ [doRound layout (snd $ last states) elfPower] + where states = takeWhile (\(f, _) -> f == True) $ iterate (\(_, a) -> doRound layout a elfPower) (True, agents) + +scoreGame :: [(Bool, Agents)] -> Int +scoreGame states = (length states - 2) * hps + where hps = sum $ map (\(Agent _ hp) -> hp) $ M.elems $ snd $ last states + +wonWithoutLoss :: [(Bool, Agents)] -> Bool +wonWithoutLoss game = startingElfs == finishingElfs + where startingElfs = M.size $ elfs $ snd $ head game + finishingElfs = M.size $ elfs $ snd $ last game -- 2.34.1