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