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 twodimensional 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 BellmanHeldKarp 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 lefthand 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 inclusionexclusion 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^{15} 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.