X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent11p.hs;h=6e4e47d83d8ca97c9641f7a458a84239baa0bb0d;hb=94acd6cb30c5ef1b1b6f364da9f91e2e00618bf8;hp=5a62ab109d88dd13f090067c5abaa88876cd88e2;hpb=598d3180bd419deb0165998bc290d291164045b8;p=advent-of-code-16.git diff --git a/advent11p.hs b/advent11p.hs index 5a62ab1..6e4e47d 100644 --- a/advent11p.hs +++ b/advent11p.hs @@ -1,6 +1,8 @@ import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices) import Data.Ord (comparing) import Data.Char (isDigit) +import Data.Maybe (fromMaybe) +import qualified Data.PQueue.Prio.Min as P data Item = Generator String | Microchip String deriving (Show, Eq) type Floor = [Item] @@ -8,6 +10,7 @@ data Building = Building Int [Floor] deriving (Show, Eq) -- data CBuilding = CBuilding Int [(Int, Int)] deriving (Show, Eq) data CBuilding = CBuilding Int Integer deriving (Show, Eq) data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int} +type Agenda = P.MinPQueue Int Agendum instance Ord Item where compare (Generator a) (Generator b) = compare a b @@ -54,7 +57,6 @@ buildingTest = Building 0 [ []] canonical :: Building -> CBuilding --- canonical (Building f floors) = CBuilding f (sort pairs) canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs) where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors floorOf (Generator g) = head (findIndices @@ -66,45 +68,39 @@ canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ so pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names - main :: IO () main = do part1 part2 - part1 :: IO () -part1 = print $ length $ trail $ aStar (initAgenda building1) [] --- part1 = print $ length $ trail $ --- aStar [Agendum {current = building1, trail=[], cost = estimateCost building1}] [] - --- part2 :: IO () --- part2 = print $ length $ init $ extractJust $ aStar [[building2]] [] +part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) [] part2 :: IO () -part2 = print $ length $ trail $aStar (initAgenda building2) [] - -initAgenda :: Building -> [Agendum] -initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}] - - -aStar :: [Agendum] -> [CBuilding] -> Agendum -aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} -aStar (currentAgendum:agenda) closed = - if isGoal reached then currentAgendum - else if creached `elem` closed - then aStar agenda closed - else aStar newAgenda (creached:closed) - where - reached = current currentAgendum - creached = canonical reached - newAgenda = - -- sortBy (\t1 t2 -> (cost t1) `compare` (cost t2)) $ - sortOn (cost) $ - agenda ++ (candidates currentAgendum closed) - - -candidates :: Agendum -> [CBuilding] -> [Agendum] +part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) [] + +initAgenda :: Building -> Agenda +initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail=[], cost = estimateCost b} + + +aStar :: Agenda -> [CBuilding] -> Maybe Agendum +-- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} +aStar agenda closed + | P.null agenda = Nothing + | otherwise = + if isGoal reached then Just currentAgendum + else if creached `elem` closed + then aStar (P.deleteMin agenda) closed + else aStar newAgenda (creached:closed) + where + (_, currentAgendum) = P.findMin agenda + reached = current currentAgendum + creached = canonical reached + newAgenda = P.union (P.deleteMin agenda) + (P.fromList $ candidates currentAgendum closed) + + +candidates :: Agendum -> [CBuilding] -> [(Int, Agendum)] candidates agendum closed = newCandidates where candidate = current agendum @@ -113,7 +109,7 @@ candidates agendum closed = newCandidates -- nonloops = (succs \\ previous) \\ closed excludable = previous ++ closed nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs - newCandidates = map (\n -> makeAgendum n) nonloops + newCandidates = map (\a -> (cost a, a)) $ map (\n -> makeAgendum n) nonloops makeAgendum new = Agendum {current = new, trail = (canonical candidate):previous, cost = estimateCost new + length previous + 1}