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