2016 Round 1C
Until the room is empty, we repeat the following. Let m be the size of the largest party, and suppose there are n parties of size m. If n is odd, we remove one senator from one of the largest parties. Otherwise we remove one senator from two of the largest parties.
If there is initially no majority party, then the above ensures it stays that way during the evacuation.
import Data.Function import Data.List import Data.Ord import Jam main = jam $ gets >> unwords . f . (`zip` ['A'..]) <$> getints f ps | null xs =  | odd (length x) = [c] : f (concat $ ((n - 1, c):as) :rest) | otherwise = [c, d] : f (concat $ ((n - 1, c):(n - 1, d):bs):rest) where xs = groupBy (on (==) fst) $ sortBy (flip compare) $ filter ((/= 0) . fst) ps (x@((n, c):as):rest) = xs ((_, d):bs) = as
Though the solution is conceptually simple, I found it hard to make the code concise. Perhaps the following is slightly better?
import Data.Function import Data.List import Data.Ord import Jam main = jam $ gets >> unwords . f . (`zip` ['A'..]) <$> getints f  =  f ps | odd n = (snd <$> take 1 xs) : f (evac xs) | otherwise = (snd <$> take 2 xs) : f (evac [h] ++ evac t) where xs@(h:t) = sortBy (flip compare) ps n = length $ head $ groupBy (on (==) fst) xs evac ((1, _):rest) = rest evac ((n, c):rest) = (n - 1, c):rest
There must be no cycles, otherwise the number of ways to reach b is infinite. Thus we relabel so that [1..b] is a topological sorting of the graph of the slides, that is, slides can only go to a building with a higher number.
This leads to the following brute force solution, though we do use recursion to count the number of ways from 1 to b. The online judge likely employs similar code for counting ways.
import Data.List import Jam main = jam $ do [b, m] <- getints let sol = find (f $ 1:replicate (b - 1) 0) as as = sequence $ sequence . (`replicate` [0, 1]) <$> [b-1,b-2..0] f [w] _ = w == m f (w:ws) (x:xs) = f (zipWith (+) ws $ map (*w) x) xs pr = map $ concatMap show . reverse . take b . (++ repeat 0) . reverse pure $ maybe "IMPOSSIBLE" (init . unlines . ("POSSIBLE" :) . pr) $ sol
The pr function is perhaps a strange way to pad a string with 0s. Also fun is init . unlines to avoid the last newline (because our Jam module will print it automatically).
For the large input, we first find some bounds. We maximize the number of ways when all possible slides are present, that is, there exists a slide from i to j whenever i < j. In this case, any increasing sequence from 1 to b is a valid path, for a total of 2^(b-2) ways. (Any subset of [2..b-1] may appear in between 1 and b.) This is the upper limit.
The lower limit is 1, achieved by constructing only a single slide from 1 to b.
How about the numbers in between? Many clues in this problem suggest that binary is involved: we have powers of two as the upper and lower limits, we have zero or one slides from each building to another, and we even see binary strings in the examples. These lead us to suspect that we can construct any number between 1 and 2^(b-2) by some form of binary encoding.
Suppose we build a slide from i to j for all i <- [2..b-1], j <- [i+1..b]. From above, if we start from building i between 2 and b-1, we count 2^(b-i-1) ways to reach b.
Binary means we can write m as a sum of powers of 2, so if we build a slide from building 1 to building i precisely when 2^(b-i-1) appears in the binary expansion of m, we see there are exactly m ways to go from 1 to b, as desired.
import Data.List import Jam main = jam $ do [b, m] <- getints let f | m > 2^(b - 2) = "IMPOSSIBLE" | m == 2^(b - 2) = g $ '0':replicate (b - 1) '1' | otherwise = g $ pr (b - 1) (bits  m) ++ "0" g s = intercalate "\n" $ "POSSIBLE":s:rest rest = take b . (++ repeat '1') . (`replicate` '0') <$> [2..b] pr k bs = concatMap show $ replicate (k - length bs) 0 ++ bs pure f bits acc 0 = acc bits acc n = bits (r:acc) q where (q, r) = divMod n 2
Here, we’ve used a different method to pad a string with 0s, and also a different method to avoid printing a newline after our solution.
When I first attempted this problem, I stumbled across a variation of the above idea. Briefly, the digits in the last column from bottom to top were 0, then the binary expansion of m, then another 0. Otherwise, every bit in the upper right triangle was set to 1. (Powers of 2 were treated slightly differently; I had failed to see this was unnecessary except for 2^b-2.)
For example, 26 is 11010 in binary, and my program would generate:
0111110 0011110 0001111 0000110 0000011 0000001 0000000
There are indeed 26 ways from building 1 to 7 in this case. Unfortunately, if m was smaller than 2^(b-3), my program would generate something like:
0011110 0001110 0000111 0000010 0000001 0000000 0000000
What a shame! I had the right idea, but a simple bug meant my efforts were all for naught.
To fix this, we could remove the bottom rows and insert appropriate top rows so we have exactly one way of reaching the former first row from building 1, or left-shift all the 1s except for those in the last column. More simply, we could set all the bits in the upper right triangle to 1, excluding the last column.
I tried brute force at first, iterating through:
subsequences $ sequence $ enumFromTo 1 <$> [j, p, s]
but I should have realized that for s <= 3, this still means we must try 2^27 possibilities. I think I was indulging in wishful thinking; I was hoping the small input would never set all of the [j, p, s] limits to 3 at the same time.
Consider the two-dimensional version of the problem, that is, suppose j = 1: we only have one jacket. (Equivalently, suppose we only have shirts and pants, and that we must never wear the same shirt more than k times, or the same pants more than k times, and we must never wear the same shirt-pants combo more than once.)
Let the point (x, y) represent the combination of shirt x and pants y. We want a subset of integer points of the rectangle:
[(x, y) | x <- [1..s], y <- [1..p]]
such that at most k points lie on the same horizontal line, and at most k points lie on the same vertical line.
Define the set d by the diagonal d = [(i, i) | i <- [1..p]]. This is the best we can do when k = 1 (though of course there are other solutions).
Otherwise translate d by adding (0, 1) to every point, wrapping around if necessary (we are painting diagonal stripes on a torus). For now assume s > 1 so that these are distinct points. Together with the original set d, this is the best we can do if k = 2: we have satisfied the conditions with 2 * p points, and by the pigeonhole principle we are unable to exceed this limit without wearing the same pants 3 times.
We iterate the above for higher values of k to solve the problem. When k = s we wind up with every lattice point in the rectangle, and going further just creates duplicate points. We could remove them with nub, but its easier to limit k to s:
oneJacket = [(a, wrap (a + b)) | a <- [1..p], b <- [0..min s k - 1]] wrap n | n > s = n - s | otherwise = n
For the full problem, we start with the above embedded in a plane:
[(0, a, wrap (a + b)) | a <- [1..p], b <- [0..min s k - 1]]
We iterate translation by (1, 1, 0) so we have a total of j such sets, each displaced from the next by one diagonal step. By a similiar argument to above, this is the best we can do.
In our solution, we shift the numbers by one here and there to reduce clutter, but the idea is the same:
import Data.List import Jam main = jam $ do [j, p, s, k] <- getints let f xyz = unwords $ show . (1 +) <$> zipWith mod xyz [j, p, s] g ps = intercalate "\n" $ show (length ps) : ps pure $ g $ map f [[a, a + b, b + c] | a <- [1..j], b <- [1..p], c <- [1..min s k]]
We use intercalate "\n" instead of unlines because we want to avoid a terminating newline in addition to the newline automatically printed by our Jam module .