1 import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
2 import Data.Ord (comparing)
3 import Data.Char (isDigit)
5 data Item = Generator String | Microchip String deriving (Show, Eq)
7 data Building = Building Int [Floor] deriving (Show, Eq)
8 -- data CBuilding = CBuilding Int [(Int, Int)] deriving (Show, Eq)
9 data CBuilding = CBuilding Int Integer deriving (Show, Eq)
10 data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
12 instance Ord Item where
13 compare (Generator a) (Generator b) = compare a b
14 compare (Microchip a) (Microchip b) = compare a b
15 compare (Generator _) (Microchip _) = LT
16 compare (Microchip _) (Generator _) = GT
18 instance Ord Building where
19 compare b1 b2 = comparing estimateCost b1 b2
21 building1 = Building 0 [
22 (sort [Generator "polonium", Generator "thulium",
23 Microchip "thulium", Generator "promethium", Generator "ruthenium",
24 Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
25 (sort [Microchip "polonium", Microchip "promethium"]),
30 building0 = Building 0 [
31 (sort [Generator "polonium", Generator "thulium",
32 Microchip "thulium", Generator "promethium"]),
33 (sort [Microchip "polonium", Microchip "promethium"]),
38 building2 = Building 0 [
39 (sort [Generator "polonium", Generator "thulium",
40 Microchip "thulium", Generator "promethium", Generator "ruthenium",
41 Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
42 Generator "elerium", Microchip "elerium",
43 Generator "dilithium", Microchip "dilithium"]),
44 (sort [Microchip "polonium", Microchip "promethium"]),
50 buildingTest = Building 0 [
51 sort([Microchip "hydrogen", Microchip "lithium"]),
52 [Generator "hydrogen"],
53 [Generator "lithium"],
56 canonical :: Building -> CBuilding
57 -- canonical (Building f floors) = CBuilding f (sort pairs)
58 canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
59 where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
60 floorOf (Generator g) = head (findIndices
61 (\fl -> (Generator g) `elem` fl)
63 floorOf (Microchip g) = head (findIndices
64 (\fl -> (Microchip g) `elem` fl)
66 pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
77 part1 = print $ length $ trail $ hillClimb (initAgenda building1) []
78 -- part1 = print $ length $ trail $
79 -- aStar [Agendum {current = building1, trail=[], cost = estimateCost building1}] []
82 -- part2 = print $ length $ init $ extractJust $ aStar [[building2]] []
85 part2 = print $ length $ trail $ hillClimb (initAgenda building2) []
87 initAgenda :: Building -> [Agendum]
88 initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
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)
98 reached = current currentAgendum
99 creached = canonical reached
101 -- sortBy (\t1 t2 -> (cost t1) `compare` (cost t2)) $
103 agenda ++ (candidates currentAgendum closed)
106 candidates :: Agendum -> [CBuilding] -> [Agendum]
107 candidates agendum closed = newCandidates
109 candidate = current agendum
110 previous = trail agendum
111 succs = legalSuccessors $ successors candidate
112 -- nonloops = (succs \\ previous) \\ closed
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}
120 isGoal :: Building -> Bool
121 isGoal (Building f floors) =
122 f+1 == height && (all (null) $ take f floors)
123 where height = length floors
125 isLegal :: Building -> Bool
126 isLegal (Building f floors) =
129 not (any (isGenerator) floor)
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
137 isGenerator :: Item -> Bool
138 isGenerator (Generator _) = True
139 isGenerator (Microchip _) = False
141 successors :: Building -> [Building]
142 successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
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]
150 legalSuccessors :: [Building] -> [Building]
151 legalSuccessors = filter (isLegal)
153 updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
154 updateBuilding oldF oldFloors newF items = Building newF newFloors
155 where newFloors = map (updateFloor) $ zip [0..] oldFloors
157 | f == oldF = sort $ fl \\ items
158 | f == newF = sort $ items ++ fl
161 estimateCost :: Building -> Int
162 estimateCost (Building _ floors) =
163 sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors