1 -- Using the idea of canonical representation of buildings from
2 -- https://andars.github.io/aoc_day11.html by Andrew Foote,
3 -- plus my extension of represening the pairs as an integer.
5 -- This version is A* search, using a list for the agenda.
7 module Main(main) where
9 import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
10 import Data.Ord (comparing)
11 import Data.Char (isDigit)
13 data Item = Generator String | Microchip String deriving (Show, Eq)
15 data Building = Building Int [Floor] deriving (Show, Eq)
16 data CBuilding = CBuilding Int Integer deriving (Show, Eq)
17 data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
19 instance Ord Item where
20 compare (Generator a) (Generator b) = compare a b
21 compare (Microchip a) (Microchip b) = compare a b
22 compare (Generator _) (Microchip _) = LT
23 compare (Microchip _) (Generator _) = GT
25 instance Ord Building where
26 compare b1 b2 = comparing estimateCost b1 b2
28 building1 = Building 0 [
29 (sort [Generator "polonium", Generator "thulium",
30 Microchip "thulium", Generator "promethium", Generator "ruthenium",
31 Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
32 (sort [Microchip "polonium", Microchip "promethium"]),
37 building0 = Building 0 [
38 (sort [Generator "polonium", Generator "thulium",
39 Microchip "thulium", Generator "promethium"]),
40 (sort [Microchip "polonium", Microchip "promethium"]),
45 building2 = Building 0 [
46 (sort [Generator "polonium", Generator "thulium",
47 Microchip "thulium", Generator "promethium", Generator "ruthenium",
48 Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
49 Generator "elerium", Microchip "elerium",
50 Generator "dilithium", Microchip "dilithium"]),
51 (sort [Microchip "polonium", Microchip "promethium"]),
57 buildingTest = Building 0 [
58 sort([Microchip "hydrogen", Microchip "lithium"]),
59 [Generator "hydrogen"],
60 [Generator "lithium"],
63 canonical :: Building -> CBuilding
64 canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
65 where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
66 floorOf (Generator g) = head (findIndices
67 (\fl -> (Generator g) `elem` fl)
69 floorOf (Microchip g) = head (findIndices
70 (\fl -> (Microchip g) `elem` fl)
72 pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
83 part1 = print $ length $ trail $ aStar (initAgenda building1) []
86 part2 = print $ length $ trail $aStar (initAgenda building2) []
88 initAgenda :: Building -> [Agendum]
89 initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
92 aStar :: [Agendum] -> [CBuilding] -> Agendum
93 aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
94 aStar (currentAgendum:agenda) closed =
95 if isGoal reached then currentAgendum
96 else if creached `elem` closed
97 then aStar agenda closed
98 else aStar newAgenda (creached:closed)
100 reached = current currentAgendum
101 creached = canonical reached
104 agenda ++ (candidates currentAgendum closed)
107 candidates :: Agendum -> [CBuilding] -> [Agendum]
108 candidates agendum closed = newCandidates
110 candidate = current agendum
111 previous = trail agendum
112 succs = legalSuccessors $ successors candidate
113 excludable = previous ++ closed
114 nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs
115 newCandidates = map (\n -> makeAgendum n) nonloops
116 makeAgendum new = Agendum {current = new,
117 trail = (canonical candidate):previous,
118 cost = estimateCost new + length previous + 1}
120 isGoal :: Building -> Bool
121 isGoal (Building f floors) =
122 f+1 == height && (all (null) $ take f floors)
123 where height = length floors
125 isLegal :: Building -> Bool
126 isLegal (Building f floors) =
129 not (any (isGenerator) floor)
132 where floor = floors!!f
133 pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
134 safePair (Generator e, Microchip f) = e == f
135 safePair (Generator _, Generator _) = False
137 isGenerator :: Item -> Bool
138 isGenerator (Generator _) = True
139 isGenerator (Microchip _) = False
141 successors :: Building -> [Building]
142 successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
145 items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
146 nextFloors = if f == 0 then [1]
147 else if f+1 == length floors then [f-1]
150 legalSuccessors :: [Building] -> [Building]
151 legalSuccessors = filter (isLegal)
153 updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
154 updateBuilding oldF oldFloors newF items = Building newF newFloors
155 where newFloors = map (updateFloor) $ zip [0..] oldFloors
157 | f == oldF = sort $ fl \\ items
158 | f == newF = sort $ items ++ fl
161 estimateCost :: Building -> Int
162 estimateCost (Building _ floors) =
163 sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors