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)
8 data Destination = Bot | Output deriving (Show, Read, Eq)
9 -- Rule bot low-destination high-destination
11 data Instruction = Rule { ruleId :: Int
12 , lowDestType :: Destination
14 , highDestType :: Destination
22 -- bod id [item1, item2]
23 data Place = Place { placeId :: Int
24 , placeType :: Destination
28 -- delivery by bot of low-value and high-value
29 data Event = Delivery { deliveryId :: Int
33 Update { updateId :: Int
34 , updateType :: Destination
38 type Factory = ([Place], [Instruction], [Event])
39 -- data FactorySt History = FactorySt (Factory -> (Factory, History))
41 emptyFactory :: Factory
42 emptyFactory = ([], [], [])
46 text <- readFile "advent10.txt"
47 let instructions = successfulParse $ parseIfile text
52 part1 :: [Instruction] -> IO ()
54 do let (_, _, events) = snd $ runState (runFactory instructions) emptyFactory
55 -- let (places, instructions, events) = snd finalFactory
56 print $ findDelivery events 17 61
58 part2 :: [Instruction] -> IO ()
60 do let (places, _, _) = snd $ runState (runFactory instructions) emptyFactory
61 let outs = findOutputs places [0, 1, 2]
62 let product = foldl1 (*) $ concatMap (items) outs
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
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
80 runFactory :: [Instruction] -> State Factory ()
81 runFactory instructions = do
82 addInstructions instructions
83 runInstructions instructions
87 instructionFile = instructionLine `endBy` newline
88 instructionLine = ruleL <|> giftL
92 do (string "bot" >> spaces)
94 (spaces >> string "gives low to" >> spaces)
95 lowDestType <- (string "output" <|> string "bot")
97 lowDest <- many1 digit
98 (spaces >> string "and high to" >> spaces)
99 highDestType <- (string "output" <|> string "bot")
101 highDest <- many1 digit
102 let rule = Rule (read bot)
103 (read $ unpack $ toTitle $ pack lowDestType)
105 (read $ unpack $ toTitle $ pack highDestType)
110 do (string "value" >> spaces)
112 (spaces >> string "goes to bot" >> spaces)
114 let gift = Gift (read bot) (read value)
118 parseIfile :: String -> Either ParseError [Instruction]
119 parseIfile input = parse instructionFile "(unknown)" input
121 parseIline :: String -> Either ParseError Instruction
122 parseIline input = parse instructionLine "(unknown)" input
124 successfulParse :: Either ParseError [a] -> [a]
125 successfulParse (Left _) = []
126 successfulParse (Right a) = a
131 addInstructions :: [Instruction] -> State Factory ()
132 addInstructions [] = return ()
133 addInstructions (i:is) = do
138 addInstruction :: Instruction -> State Factory ()
139 addInstruction r@(Rule {}) =
140 do (places, rules, history) <- get
141 put (places, r:rules, history)
142 addPlace (Place {placeType = (lowDestType r), placeId = (lowDestId r), items = []})
143 addPlace (Place {placeType = (highDestType r), placeId = (highDestId r), items = []})
145 addInstruction g@(Gift {}) =
146 -- do (botstates, rules, history) <- get
147 -- let (bot, otherBots) = getBot receivingBot botstates
148 -- let rBot = BotState {botId = (botId bot), items = (value:(items bot))}
149 -- put (rBot:otherBots, rules, history)
150 do addPlace (Place {placeType = Bot, placeId = (giftId g), items = []})
152 -- propogateUpdates :: State Factory ()
153 -- propogateUpdates = State $ \factory -> ((), factory')
156 addPlace :: Place -> State Factory ()
158 do (places, rules, history) <- get
159 if not $ placeElem place places
160 then put ((place:places), rules, history)
164 runInstructions :: [Instruction] -> State Factory ()
165 runInstructions [] = return ()
166 runInstructions (i:is) =
171 runInstruction :: Instruction -> State Factory ()
172 runInstruction r@(Rule {}) = return ()
173 runInstruction g@(Gift {}) =
174 do (places, rules, history) <- get
175 updatePlace (giftId g) Bot (value g)
178 updatePlace :: Int -> Destination -> Int -> State Factory ()
180 do (places, instructions, events) <- get
181 let (place0s, otherPlaces) = partition (samePlace (Place {placeId = b, placeType = d, items = []})) places
182 let place = head place0s
183 let place' = place {items = i:(items place)}
184 let update = Update {updateId = b, updateType = d, updateItem = i}
185 put (place':otherPlaces, instructions, update:events)
188 propogateUpdates :: State Factory ()
190 do (places, instructions, events) <- get
191 let (fullBots, otherPlaces) = fullRobots places
192 if (not . null) fullBots
193 then do let fullBot = head fullBots
194 let maybeRule = findRule instructions (placeId fullBot)
196 Nothing -> propogateUpdates
197 Just rule -> do let small:large:_ = sort $ items fullBot
198 let emptyBot = fullBot {items = []}
199 let delivery = Delivery { deliveryId = placeId fullBot
200 , lowDelivery = small
201 , highDelivery = large
203 put (emptyBot:(tail fullBots) ++ otherPlaces,
206 updatePlace (lowDestId rule) (lowDestType rule) small
207 updatePlace (highDestId rule) (highDestType rule) large
212 placeElem :: Place -> [Place] -> Bool
213 placeElem place places = (not . null) $ findIndices (samePlace place) places
215 samePlace :: Place -> Place -> Bool
216 samePlace p1 p2 = (placeId p1 == placeId p2) && (placeType p1 == placeType p2)
218 fullRobots :: [Place] -> ([Place], [Place])
219 fullRobots places = partition (\p -> placeType p == Bot && length (items p) >= 2) places
221 findRule :: [Instruction] -> Int -> Maybe Instruction
222 findRule instructions bot = find ruleForBot instructions
223 where ruleForBot Gift {} = False
224 ruleForBot Rule {ruleId = b}
228 -- getPlace :: Place -> [Place] -> (Place, [Place])
229 -- getBot botID bots = ((head foundBots), otherbots)
230 -- where (foundBots, otherbots) = partition (\b -> (botId b) == botID) bots