Starting branch for A-star search in day 11
[advent-of-code-16.git] / advent10.hs
1 import Text.Parsec hiding (State)
2 -- import Control.Applicative ((<$), (<*), (*>), (<*>), liftA)
3 -- import Data.List (partition, union, intersect, tails)
4 import Data.Text (pack, unpack, toTitle)
5 import Control.Monad.State.Lazy
6 import Data.List (partition, findIndices, sort, find)
7
8 data Destination = Bot | Output deriving (Show, Read, Eq)
9 -- Rule bot low-destination high-destination
10 -- Gift bot value
11 data Instruction = Rule { ruleId :: Int
12 , lowDestType :: Destination
13 , lowDestId :: Int
14 , highDestType :: Destination
15 , highDestId :: Int
16 } |
17 Gift { giftId :: Int
18 , value :: Int
19 }
20 deriving (Show)
21
22 -- bod id [item1, item2]
23 data Place = Place { placeId :: Int
24 , placeType :: Destination
25 , items :: [Int]}
26 deriving (Show)
27
28 -- delivery by bot of low-value and high-value
29 data Event = Delivery { deliveryId :: Int
30 , lowDelivery :: Int
31 , highDelivery :: Int
32 } |
33 Update { updateId :: Int
34 , updateType :: Destination
35 , updateItem :: Int
36 } deriving (Show)
37
38 type Factory = ([Place], [Instruction], [Event])
39 -- data FactorySt History = FactorySt (Factory -> (Factory, History))
40
41 emptyFactory :: Factory
42 emptyFactory = ([], [], [])
43
44 main :: IO ()
45 main = do
46 text <- readFile "advent10.txt"
47 let instructions = successfulParse $ parseIfile text
48 part1 instructions
49 part2 instructions
50
51
52 part1 :: [Instruction] -> IO ()
53 part1 instructions =
54 do let (_, _, events) = snd $ runState (runFactory instructions) emptyFactory
55 -- let (places, instructions, events) = snd finalFactory
56 print $ findDelivery events 17 61
57
58 part2 :: [Instruction] -> IO ()
59 part2 instructions =
60 do let (places, _, _) = snd $ runState (runFactory instructions) emptyFactory
61 let outs = findOutputs places [0, 1, 2]
62 let product = foldl1 (*) $ concatMap (items) outs
63 print $ product
64
65
66 findDelivery :: [Event] -> Int -> Int -> Maybe Event
67 findDelivery events lowItem highItem = find (delivery) events
68 where delivery Update {} = False
69 delivery Delivery {deliveryId = bot, lowDelivery = l, highDelivery = h}
70 | l == lowItem && h == highItem = True
71 | otherwise = False
72
73 findOutputs :: [Place] -> [Int] -> [Place]
74 findOutputs outputs ids = filter (interesting) outputs
75 where interesting Place {placeId = p, placeType = t, items = i}
76 | (p `elem` ids) && t == Output = True
77 | otherwise = False
78
79
80 runFactory :: [Instruction] -> State Factory ()
81 runFactory instructions = do
82 addInstructions instructions
83 runInstructions instructions
84
85
86
87 instructionFile = instructionLine `endBy` newline
88 instructionLine = ruleL <|> giftL
89
90
91 ruleL =
92 do (string "bot" >> spaces)
93 bot <- many1 digit
94 (spaces >> string "gives low to" >> spaces)
95 lowDestType <- (string "output" <|> string "bot")
96 spaces
97 lowDest <- many1 digit
98 (spaces >> string "and high to" >> spaces)
99 highDestType <- (string "output" <|> string "bot")
100 spaces
101 highDest <- many1 digit
102 let rule = Rule (read bot)
103 (read $ unpack $ toTitle $ pack lowDestType)
104 (read lowDest)
105 (read $ unpack $ toTitle $ pack highDestType)
106 (read highDest)
107 return rule
108
109 giftL =
110 do (string "value" >> spaces)
111 value <- many1 digit
112 (spaces >> string "goes to bot" >> spaces)
113 bot <- many1 digit
114 let gift = Gift (read bot) (read value)
115 return gift
116
117
118 parseIfile :: String -> Either ParseError [Instruction]
119 parseIfile input = parse instructionFile "(unknown)" input
120
121 parseIline :: String -> Either ParseError Instruction
122 parseIline input = parse instructionLine "(unknown)" input
123
124 successfulParse :: Either ParseError [a] -> [a]
125 successfulParse (Left _) = []
126 successfulParse (Right a) = a
127
128
129
130
131 addInstructions :: [Instruction] -> State Factory ()
132 addInstructions [] = return ()
133 addInstructions (i:is) = do
134 addInstruction i
135 addInstructions is
136
137
138 addInstruction :: Instruction -> State Factory ()
139 addInstruction r@(Rule {lowDestType = ld, lowDestId = li,
140 highDestType = hd, highDestId = hi}) =
141 do (places, rules, history) <- get
142 put (places, r:rules, history)
143 addPlace (Place {placeType = ld, placeId = li, items = []})
144 addPlace (Place {placeType = hd, placeId = hi, items = []})
145 addInstruction Gift {giftId = g} =
146 do addPlace (Place {placeType = Bot, placeId = g, items = []})
147
148
149 addPlace :: Place -> State Factory ()
150 addPlace place =
151 do (places, rules, history) <- get
152 if not $ placeElem place places
153 then put ((place:places), rules, history)
154 else return ()
155
156
157 runInstructions :: [Instruction] -> State Factory ()
158 runInstructions [] = return ()
159 runInstructions (i:is) =
160 do runInstruction i
161 runInstructions is
162
163
164 runInstruction :: Instruction -> State Factory ()
165 runInstruction Rule {} = return ()
166 runInstruction g@(Gift {}) =
167 do updatePlace (giftId g) Bot (value g)
168 propogateUpdates
169
170 updatePlace :: Int -> Destination -> Int -> State Factory ()
171 updatePlace b d i =
172 do (places, instructions, events) <- get
173 let (place0s, otherPlaces) = partition (samePlace (Place {placeId = b, placeType = d, items = []})) places
174 let place = head place0s
175 let place' = place {items = i:(items place)}
176 let update = Update {updateId = b, updateType = d, updateItem = i}
177 put (place':otherPlaces, instructions, update:events)
178
179
180 propogateUpdates :: State Factory ()
181 propogateUpdates =
182 do (places, instructions, events) <- get
183 let (fullBots, otherPlaces) = fullRobots places
184 if (not . null) fullBots
185 then do let fullBot = head fullBots
186 let maybeRule = findRule instructions (placeId fullBot)
187 case maybeRule of
188 Nothing -> propogateUpdates
189 Just rule -> do let small:large:_ = sort $ items fullBot
190 let emptyBot = fullBot {items = []}
191 let delivery = Delivery { deliveryId = placeId fullBot
192 , lowDelivery = small
193 , highDelivery = large
194 }
195 put (emptyBot:(tail fullBots) ++ otherPlaces,
196 instructions,
197 delivery:events)
198 updatePlace (lowDestId rule) (lowDestType rule) small
199 updatePlace (highDestId rule) (highDestType rule) large
200 propogateUpdates
201 else return ()
202
203
204 placeElem :: Place -> [Place] -> Bool
205 placeElem place places = (not . null) $ findIndices (samePlace place) places
206
207 samePlace :: Place -> Place -> Bool
208 samePlace p1 p2 = (placeId p1 == placeId p2) && (placeType p1 == placeType p2)
209
210 fullRobots :: [Place] -> ([Place], [Place])
211 fullRobots places = partition (\p -> placeType p == Bot && length (items p) >= 2) places
212
213 findRule :: [Instruction] -> Int -> Maybe Instruction
214 findRule instructions bot = find ruleForBot instructions
215 where ruleForBot Gift {} = False
216 ruleForBot Rule {ruleId = b}
217 | b == bot = True
218 | otherwise = False