import Jam import Data.Bool main = jam $ do [_, b] < getints pure $ bool "WHITE" "BLACK" $ odd b
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.
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 thatf
takes 2 arguments. An alternative is to uncurryf
and use plainmemo
. This might be faster in some cases, but seems negligible here. 
Replace calls to
f
with calls tog
. 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.