Contents

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.

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

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 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

GoroSort

Consider the cycle decomposition of a given permutation. Goro’s best strategy is to repeat the following steps:

  1. If all cycles have length 1 then we are done.

  2. 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..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)
Contents
Ben Lynn blynn@cs.stanford.edu 💡