2011 Qualification Round
We simulate the optimal actions of Blue and Orange one second at a time. It turns out lookup returns the first match in a list, so we use it to find the next button for each robot, if it exists.
If a robot has nothing to do, it idles. If both have nothing to do, this implies the list of reamining buttons is empty, so we are done. Otherwise a robot either moves towards its button or pushes the button it has reached.
import Data.Bool import Data.List.Split import Jam pos 'B' = head pos 'O' = head . tail f acc _  = acc f acc bo rps@((r, p):rest) = f (acc + 1) (go bo rps) $ bool rps rest (pos r bo == p) go bo rps = zipWith move bo $ (`lookup` rps) <$> "BO" move x Nothing = x move x (Just gx) = x + signum (gx - x) parse = map $ \[[r], p] -> (r, read p) main = jam $ show . f 0 [1, 1] . parse . chunksOf 2 . tail . words <$> gets
A straightforward problem. We parse the input into a map for pairs of elements that can combined, and a set for the destructive pairs. We store both orderings.
Then we step through the element list. If we find a combination in the map, then we apply it and recurse. If we find a destructive pair we erase our current output string and recurse. Otherwise we add the element to the output string and recurse.
Because of Haskell lists, we prepend characters to the running output. We reverse the final output before printing.
import Jam import Data.List import qualified Data.Map as M import qualified Data.Set as S main = jam $ do (cmap, dmap, s) <- parse . words <$> gets let f s r@(a:b:rest) = case M.lookup [a, b] cmap of Just c -> f s (c:rest) Nothing -> g s $ if or [S.member [a, x] dmap | x <- b:rest] then "" else r f s r = g s r g  r = r g (x:xs) r = f xs (x:r) pure $ concat ["[", intercalate ", " $ map pure $ reverse $ g s "", "]"] parse (_n:xs) = let (cs, _m:xs1) = splitAt (read _n) xs (ds, _:[s]) = splitAt (read _m) xs1 cmap = M.fromList $ concatMap (\[a, b, c] -> [([a, b], c), ([b, a], c)]) cs dmap = S.fromList $ concatMap (\[a, b] -> [[a, b], [b, a]]) ds in (cmap, dmap, s)
Patrick is computing the parity checksum (map xor) of each pile. We can split the candy into two piles with the same checksum if and only if the checksum of all the candy is zero. When the checksum is zero, any split will work, so we give Patrick the smallest piece (we’re obliged to give at least one since both piles must be non-empty), and Sean takes the rest.
import Data.Bits import Data.List import Jam f cs | foldl1' xor cs == 0 = show $ sum cs - foldl1' min cs | otherwise = "NO" main = jam $ gets >> f <$> getints
Consider the cycle decomposition of a given permutation. Goro’s best strategy is to repeat the following steps:
If all cycles have length 1 then we are done.
Otherwise pick any cycle of length 2 or more. Hold down everything except this cycle and shuffle.
Let f(k) be the expected number of steps to GoroSort a single cycle of length k, and let g(k) be the expected number of steps to GoroSort permutations of k objects in general. Both functions are zero when k <- [0, 1].
For higher k, first consider an element x in a cycle of length k. If Goro shuffles just this cycle, then we find for each i <- [1..k] there is a 1/k probability that x winds up in a cycle of length i. Thus:
f(k) = 1 + sum [(1/k)*(f(i) + g(n - i)) | i <- [1..k]]
f k = (k + sum ([f, g] <*> [1..k-1])) / (k - 1)
Here, we’re using applicative functors to express:
[f, g] <*> [1..k-1] = [f 1, g 1, f 2, g 2, ..., f (k - 1), g (k - 1)]
As for g(k), for i <- [1..k], the element x lies in a cycle of length i in exactly of 1/k of all permutations of order k. We expect it takes f(i) to sort the cycle containing x, and another g(k - i) steps to sort the rest:
g k = sum ([f, g . (k -)] <*> [1..k]) / k
Further simplifications are probably possible, but this will do. We memoize these mutual recursions to efficiently compute:
sum (map f) cs
where cs are the cycle lengths of the input permutation.
import Jam import Data.List import Data.MemoTrie import Text.Printf f :: Int -> Double f 0 = 0 f 1 = 0 f n = (fromIntegral n + sum ([mf, mg] <*> [1..n-1])) / fromIntegral (n - 1) mf = memo f g :: Int -> Double g 0 = 0 g 1 = 0 g n = sum ([mf, mg . (n -)] <*> [1..n]) / fromIntegral n mg = memo g main = jam $ gets >> printf "%.6f" . sum . map mf . cycles  . zip [1..] <$> getints where cycles acc  = acc cycles acc ((_, j):rest) = cycles (a:acc) b where (a, b) = f 1 j rest f sz j xs = case lookup j xs of Nothing -> (sz, xs) Just k -> f (sz + 1) k (delete (j, k) xs)