Variious implementations

[advent-of-code-16.git] / advent11p.hs

diff --git a/advent11p.hs b/advent11p.hs
index 5a62ab109d88dd13f090067c5abaa88876cd88e2..6e4e47d83d8ca97c9641f7a458a84239baa0bb0d 100644 (file)
--- 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}