import Data.List import qualified Data.Set as S import Jam main = jam $ do [s] <- getints ss <- S.fromList <$> getsn s [q] <- getints qs <- getsn q return $ show $ solve ss qs solve s qs = fst $ foldl' g (0, S.empty) qs where g (n, t) q | S.notMember q s = (n , t) | s /= t' = (n , t') | otherwise = (n + 1, S.singleton q) where t' = S.insert q t
2008 Qualification Round
Saving the Universe
Let S be the set of search engines. We maintain another set of search engines T that is initially empty. We iterate through the sequence of queries.
If the current query q
is the name of a search engine, we insert it in T.
Alternatively, we could have used filter
here. If T is still a proper subset
of S then we continue to the next query. Otherwise, S = T, in which case the
search engine we’ve been using until now should be q
, and we must switch to
another search engine, the choice of which is yet to be determined. We set T to
be the singleton set containing q
and continue to the next query.
Train Timetable
We construct an event log, which consist of a timestamp and each event is either of the form "a train leaves station S" or "a train is ready to leave station S", where S is either A or B.
We sort this log by timestamp, and for events with the same timestamp, we ensure the "train is ready" events take precedence. Then we replay the log while maintaining two counters per station, which we’ll call
-
The number of trains we need at the beginning.
-
The current number of trains at the station.
In detail, when a train leaves station S, we decrement the second counter for station S unless it is zero in which case we increment the first counter for S. Also, when a train arrives at S, we increment the second counter for S.
After replaying the log, we print the first counters of the two stations.
import Data.List import Jam toTime s = let (hh, ':':mm) = break (== ':') s in read hh * 60 + read mm toTimes = map $ (\[a, b] -> (toTime a, toTime b)) . words record t [e0, e1] as es = foldl' (\es (t0, t1) -> ((t0, e0):(t1 + t, e1):es)) es as main = jam $ do [t] <- getints [na, nb] <- getints as <- getsn na bs <- getsn nb let es0 = record t ["1A", "0A"] (toTimes as) [] es1 = record t ["1B", "0B"] (toTimes bs) es0 es = sort es1 ((a, b), _) = foldl' (\((a0, b0), (a, b)) (_, e) -> case e of "0A" -> ((a0, b0), (a, b+1)) "0B" -> ((a0, b0), (a+1, b)) "1A" -> if a == 0 then ((a0+1, b0), (a, b)) else ((a0, b0), (a-1, b)) "1B" -> if b == 0 then ((a0, b0+1), (a, b)) else ((a0, b0), (a, b-1)) ) ((0, 0), (0, 0)) es return $ show a ++ " " ++ show b
Fly Swatter
The fly survives if it fits between the strings, that is, if its center lies in a square with side length (g - 2*f) centered within a hole, and if the hole borders the ring, then the center must be within (R - t - f) of the center of the ring.
By symmetry, we can solve for the half of a quadrant of the racket. We’ll focus on the sector between 0 and pi/4 radians.
If (g - 2f) is zero or less, then the fly dies, otherwise we consider the x-coordinates of the edges of the squares where the fly must be centered to survive; the y-coordinates are similar. The first square lies between (r + f) and (r + g - f), and in general the (k - 1)th square lies between (r + f) + (2r + g) k and (r + g - f) + (2r + g) k.
Then for:
x <- [r+f, r+f+d..R-t-f], y <- [r+f, r+f+d..x]
we check if the square with bottom-left corner (x, y) lies at least partially in the ring. If so, then we add its area to a running sum, first halving it if x and y are equal. If the square fully lies within the ring, then its area is simply (g - 2*f)^2, otherwise we must first intersect it with the circle of radius (R - t - f) centered at the origin.
There are 4 cases depending on how many corners of the square lie within the ring. All require computing the area of a segment. We find the points of intersection with the ring P and Q via the equation for a circle x2 + y2 = r2. Then we take the dot product of OP and OQ, divide by r2, and take the inverse cosine to determine the angle, which we use to find the area of the sector POQ. Lastly, we subtract the area of the triangle POQ to get the area of the segment, using a simple formula from linear algebra.
The other part is easy: we add the area of a triangle, trapezium, or truncated square.
This turns out to be fast enough for the large input. However, we also implement a faster version for training purposes: a couple of divisions can determine the number of squares in a given row lie completely in the ring. We multiply this by (g - 2*f)2 and add the areas of the partial squares as before.
import Jam import Text.Printf main = jam $ do [f, rr, t, r, g] <- getdbls let slice = pi * rr^2 / 8 s = g - 2 * f d = 2 * r + g r2 = (rr - t - f)^2 inring x y = x^2 + y^2 <= r2 seg (x1, y1) (x2, y2) = 0.5 * (acos ((x1*x2 + y1*y2) / r2) * r2 - abs (x1*y2 - x2*y1)) partial x y = case (inring (x+s) y, inring x (y+s)) of -- One corner lies inside the ring. (False, False) -> let a = sqrt(r2 - y^2) b = sqrt(r2 - x^2) in seg (a, y) (x, b) + (a - x)*(b - y)*0.5 -- Both left corners lie inside the ring. (False, True) -> let a1 = sqrt(r2 - y^2) a2 = sqrt(r2 - (y+s)^2) in seg (a1, y) (a2, y + s) + s*((a1 + a2)*0.5 - x) -- Both bottom corners lie inside the ring. -- This seems to be impossible? (True, False) -> let b1 = sqrt(r2 - x^2) b2 = sqrt(r2 - (x+s)^2) in seg (x, b1) (x + s, b2) + s*((b1 + b2)*0.5 - y) -- Three corners lie inside the ring. (True, True) -> let a = sqrt(r2 - (y+s)^2) b = sqrt(r2 - (x+s)^2) in seg (x+s, b) (a, y+s) + s^2 - (x + s - a)*(y + s - b)*0.5 try x = if 2*x^2 > r2 then 0 else (let k = floor $ (sqrt(r2 - x^2) - x) / d k1 = floor $ (sqrt(r2 - (x+s)^2) - (x+s)) / d f j = sum [partial (x + d*fromIntegral i) x | i <- [j..k]] in (if k1 >= 0 then fromIntegral k1 * s^2 + 0.5 * s^2 + f (k1 + 1) else 0.5 * partial x x + f 1)) + try (x + d) brute = sum [(if x == y then 0.5 else 1.0) * (if inring x y then (if inring (x + s) (y + s) then s^2 else partial x y) else 0) | x <- [r+f, r+f+d..rr-t-f], y <- [r+f, r+f+d..x]] -- Slower, but easier. -- return $ printf "%.6f" $ if s <= 0 then 1 else 1 - brute / slice return $ printf "%.6f" $ if s <= 0 then 1 else 1 - try (r + f) / slice