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