Tidying, especially the parser
[advent-of-code-16.git] / adventofcode16 / app / advent11a.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 list 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
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
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
24
25 instance Ord Building where
26 compare b1 b2 = comparing estimateCost b1 b2
27
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"]),
33 [],
34 []
35 ]
36
37 building0 = Building 0 [
38 (sort [Generator "polonium", Generator "thulium",
39 Microchip "thulium", Generator "promethium"]),
40 (sort [Microchip "polonium", Microchip "promethium"]),
41 [],
42 []
43 ]
44
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"]),
52 [],
53 []
54 ]
55
56
57 buildingTest = Building 0 [
58 sort([Microchip "hydrogen", Microchip "lithium"]),
59 [Generator "hydrogen"],
60 [Generator "lithium"],
61 []]
62
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)
68 floors)
69 floorOf (Microchip g) = head (findIndices
70 (\fl -> (Microchip g) `elem` fl)
71 floors)
72 pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
73
74
75
76 main :: IO ()
77 main = do
78 part1
79 part2
80
81
82 part1 :: IO ()
83 part1 = print $ length $ trail $ aStar (initAgenda building1) []
84
85 part2 :: IO ()
86 part2 = print $ length $ trail $aStar (initAgenda building2) []
87
88 initAgenda :: Building -> [Agendum]
89 initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
90
91
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)
99 where
100 reached = current currentAgendum
101 creached = canonical reached
102 newAgenda =
103 sortOn (cost) $
104 agenda ++ (candidates currentAgendum closed)
105
106
107 candidates :: Agendum -> [CBuilding] -> [Agendum]
108 candidates agendum closed = newCandidates
109 where
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}
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