2008 Practice Contest

Old Magician

Each iteration the number of black balls remains the same or decreases by two, thus we print "WHITE" if B is even, and "BLACK" if B is odd. For fun, we use the bool function from Data.Bool, which is somewhat like the ternary operator of C.

import Jam
import Data.Bool

main = jam $ do
  [_, b] <- getints
  pure $ bool "WHITE" "BLACK" $ odd b

Square Fields

The small case looks amenable to brute force: for every partition of the N points into K subsets, we compute the bounding boxes for each of the subsets and find the largest side length. Our answer is the minimum such length.

Recursion is an elegant technique for finding all partitions. Our function f solves the problem, for a bitset B that represents the points to be partitioned, along with k, the number of partitions.

The base case k = 1 corresponds to putting the entire input set in one partition, so the minimum length is the largest side of the bounding box of the set. Another terminating condition is when k is at least as large as the size of the input set: in this case, all remaining points can be covered by squares of size 0, so we return 0.

Otherwise for every proper subset S of the input set (Haskell’s subsequences function works well), we shall choose S as our first partition. Thus we find the largest side of the bounding box of S, recursively call f on B \ S and k - 1, and return the larger of the two. Finally, we return the smallest of these answers.

We have ignored a simple optimization: f should mark some element of B (say the one with the lowest index), then only iterate over subsets S that contain this element.

We have also completely ignored optimizations related to the nature of two-dimensional space. For example, it may be that once certain points are covered by the same square, there are many points in between that must also be covered.

import Jam
import Data.Bits
import Data.List

minX = minimum . map fst
maxX = maximum . map fst
minY = minimum . map snd
maxY = maximum . map snd

main = jam $ do
  [n, k] <- getints
  xys <- map (\[a, b] -> (a, b)) <$> getintsn n
  let
    ones bs = filter (testBit bs) [0..n - 1]
    bbox bs = max (maxX a - minX a) (maxY a - minY a)
      where a = (xys!!) <$> ones bs
    f :: Int -> Int -> Int
    f bs 1 = bbox bs
    f bs k
      | popCount bs <= k = 0
      | otherwise        = minimum [max (bbox s) $ f (bs - s) (k - 1) |
         sub <- subsequences $ ones bs,
         let s = sum $ map (2^) sub, s /= 0, s /= bs]

  pure $ show $ f (2^n - 1) k

Once we’ve gotten this far, solving the large case turns out to be easy: just memoize!

Dynamic programming based on subsets of a set is invaluable for programming contests. For example, it is the linchpin of the Bellman-Held-Karp algorithm for the Traveling Salesman Problem. A hint that we should consider such an algorithm is that even the large input only has N = 15 or so: this tells us we may reasonably use 2^N time and space.

import Jam
import Data.Bits
import Data.List
import Data.MemoTrie

minX = minimum . map fst
maxX = maximum . map fst
minY = minimum . map snd
maxY = maximum . map snd

main = jam $ do
  [n, k] <- getints
  xys <- map (\[a, b] -> (a, b)) <$> getintsn n
  let
    ones bs = filter (testBit bs) [0..n - 1]
    bbox bs = max (maxX a - minX a) (maxY a - minY a)
      where a = (xys!!) <$> ones bs
    f :: Int -> Int -> Int
    f bs 1 = bbox bs
    f bs k
      | popCount bs <= k = 0
      | otherwise        = minimum [max (bbox s) $ g (bs - s) (k - 1) |
         sub <- subsequences $ ones bs,
         let s = sum $ map (2^) sub, s /= 0, s /= bs]
    g = memo2 f

Memoization is trivial with Data.MemoTrie:

Add g = memo2 f. Here, the 2 means that f takes 2 arguments. An alternative is to uncurry f and use plain memo. This might be faster in some cases, but seems negligible here.
Replace calls to f with calls to g. Thus apart from the new line, f only appears on the left-hand side of (=).

Cycles

Haskell’s permutations function leads to an easy brute force solution for the small input. We represent each cycle uniquely up to direction by forcing them to start from the node 1. Thus we prepend and append 1 to all permutations of [2..n] to generate all cycles.

Then we count the number of these cycles that contain none of the forbidden edges. We use isInfixOf to search for the forbidden edges; we invoke map reverse on the edges to search for them in both directions.

We divide by 2 because we have counted each cycle twice, one for each direction we can traverse the cycle. (These two paths are always distinct because we’re given n >= 3.)

import Jam
import Data.List

main = jam $ do
  [n, k] <- getints
  es <- getintsn k
  return $ show $ (`mod` 9901) $ (`div` 2) $ length $
    filter (\p -> not $ any (`isInfixOf` p) $ es ++ map reverse es) $
      map ((1:) . (++ [1])) $ permutations [2..n]

For the large case, we apply the inclusion-exclusion principle. We start with the total number of cycles. Then for each forbidden edge e, we subtract the cycles containing e. Then for each pair of forbidden edges e0, e1, we add back the cycles containing both e0 and e1. Then for all triplets of edges we subtract, and so on.

Haskell’s subsequences lets us easily iterate through all these. There are at most 2¹⁵ subsets of forbidden edges, so this approach should be fast enough.

However, we must account for cycles in the subsets of forbidden edges. Suppose a subset of forbidden edges S contains a cycle. If S exactly describes a cycle of length n, then it is the unique Hamiltonian cycle on the complete graph that goes through every edge of S. Otherwise, it is impossible for a Hamiltonian cycle to go through every edge of S.

Our cycle detection is clumsy, and unnecessarily informative. We only want to know if there is a cycle and whether it uses all the given edges. But it’s good enough for the contest.

import Jam
import Data.List
import qualified Data.Map as M

f 0 = 1
f n = n * f (n - 1)

getCycle [] = 0
getCycle ([v, w]:es) = go es w $ M.fromList [(v, w)]

go es v m = let (as, bs) = break (v `elem`) es in case bs of
  [] -> getCycle as
  (b:rest) -> let
    Just w = find (/= v) b
    in if M.member w m
      then numSteps 1 w v m
      else go (as ++ rest) w $ M.insert v w m

numSteps acc v w m
  | v == w    = acc
  | otherwise = numSteps (acc + 1) (m M.! v) w m

main = jam $ do
  [nInt, k] <- getints
  edges <- getintsn k
  let
    n = fromIntegral nInt :: Integer
    g es
      | any (>= 3) ds = 0
      | getCycle es > 0 = if getCycle es == n && r == n then (-1)^r else 0
      | otherwise = (-1)^r * f (n - 1 - r) *
        2^(r - fromIntegral (length $ filter (== 2) ds)) `div` 2
      where
        ds = M.elems $ M.fromListWith (+) $ zip (concat es) (repeat 1)
        r  = fromIntegral $ length es
  return $ show $ (`mod` 9901) $ sum $ map g $ subsequences edges

We use arbitrary precision integers to avoid thinking about how to divide by 2 when we must give the answer modulo 9901. The numbers are small enough to get away with this.

We use Data.Map to speed up vertex lookups during cycle detection.

Ben Lynn blynn@cs.stanford.edu 💡

2008 Practice Contest

Old Magician

Square Fields

Cycles

Contents