More tidying
[advent-of-code-16.git] / advent11p.hs
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.
4
5 -- This version is A* search, using a priority queue for the agenda.
6
7 import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
8 import Data.Ord (comparing)
9 import Data.Char (isDigit)
10 import Data.Maybe (fromMaybe)
11 import qualified Data.PQueue.Prio.Min as P
12
13 data Item = Generator String | Microchip String deriving (Show, Eq)
14 type Floor = [Item]
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}
18 type Agenda = P.MinPQueue Int Agendum
19
20 instance Ord Item where
21 compare (Generator a) (Generator b) = compare a b
22 compare (Microchip a) (Microchip b) = compare a b
23 compare (Generator _) (Microchip _) = LT
24 compare (Microchip _) (Generator _) = GT
25
26 instance Ord Building where
27 compare b1 b2 = comparing estimateCost b1 b2
28
29 building1 = Building 0 [
30 (sort [Generator "polonium", Generator "thulium",
31 Microchip "thulium", Generator "promethium", Generator "ruthenium",
32 Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
33 (sort [Microchip "polonium", Microchip "promethium"]),
34 [],
35 []
36 ]
37
38 building0 = Building 0 [
39 (sort [Generator "polonium", Generator "thulium",
40 Microchip "thulium", Generator "promethium"]),
41 (sort [Microchip "polonium", Microchip "promethium"]),
42 [],
43 []
44 ]
45
46 building2 = Building 0 [
47 (sort [Generator "polonium", Generator "thulium",
48 Microchip "thulium", Generator "promethium", Generator "ruthenium",
49 Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
50 Generator "elerium", Microchip "elerium",
51 Generator "dilithium", Microchip "dilithium"]),
52 (sort [Microchip "polonium", Microchip "promethium"]),
53 [],
54 []
55 ]
56
57
58 buildingTest = Building 0 [
59 sort([Microchip "hydrogen", Microchip "lithium"]),
60 [Generator "hydrogen"],
61 [Generator "lithium"],
62 []]
63
64 canonical :: Building -> CBuilding
65 canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
66 where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
67 floorOf (Generator g) = head (findIndices
68 (\fl -> (Generator g) `elem` fl)
69 floors)
70 floorOf (Microchip g) = head (findIndices
71 (\fl -> (Microchip g) `elem` fl)
72 floors)
73 pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
74
75
76 main :: IO ()
77 main = do
78 part1
79 part2
80
81 part1 :: IO ()
82 part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) []
83
84 part2 :: IO ()
85 part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) []
86
87 initAgenda :: Building -> Agenda
88 initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail=[], cost = estimateCost b}
89
90
91 aStar :: Agenda -> [CBuilding] -> Maybe Agendum
92 -- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
93 aStar agenda closed
94 | P.null agenda = Nothing
95 | otherwise =
96 if isGoal reached then Just currentAgendum
97 else if creached `elem` closed
98 then aStar (P.deleteMin agenda) closed
99 else aStar newAgenda (creached:closed)
100 where
101 (_, currentAgendum) = P.findMin agenda
102 reached = current currentAgendum
103 creached = canonical reached
104 newAgenda = P.union (P.deleteMin agenda)
105 (P.fromList $ candidates currentAgendum closed)
106
107
108 candidates :: Agendum -> [CBuilding] -> [(Int, Agendum)]
109 candidates agendum closed = newCandidates
110 where
111 candidate = current agendum
112 previous = trail agendum
113 succs = legalSuccessors $ successors candidate
114 nonloops = filter (\s -> not $ (canonical s) `elem` closed) succs
115 newCandidates = map (\a -> (cost a, a)) $ map (\n -> makeAgendum n) nonloops
116 makeAgendum new = Agendum {current = new,
117 trail = (canonical candidate):previous,
118 cost = estimateCost new + length previous + 1}
119
120 isGoal :: Building -> Bool
121 isGoal (Building f floors) =
122 f+1 == height && (all (null) $ take f floors)
123 where height = length floors
124
125 isLegal :: Building -> Bool
126 isLegal (Building f floors) =
127 null floor
128 ||
129 not (any (isGenerator) floor)
130 ||
131 any (safePair) pairs
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
136
137 isGenerator :: Item -> Bool
138 isGenerator (Generator _) = True
139 isGenerator (Microchip _) = False
140
141 successors :: Building -> [Building]
142 successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
143 where
144 floor = floors!!f
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]
148 else [f+1, f-1]
149
150 legalSuccessors :: [Building] -> [Building]
151 legalSuccessors = filter (isLegal)
152
153 updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
154 updateBuilding oldF oldFloors newF items = Building newF newFloors
155 where newFloors = map (updateFloor) $ zip [0..] oldFloors
156 updateFloor (f, fl)
157 | f == oldF = sort $ fl \\ items
158 | f == newF = sort $ items ++ fl
159 | otherwise = fl
160
161 estimateCost :: Building -> Int
162 estimateCost (Building _ floors) =
163 sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
164