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