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
2011 Qualification Round
Bot Trust
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.
Magicka
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)
Candy Splitting
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 nonempty), 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
GoroSort
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]]
Rearranging:
f k = (k + sum ([f, g] <*> [1..k1])) / (k  1)
Here, we’re using 'applicative functors' to express:
[f, g] <*> [1..k1] = [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..n1])) / 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)