import Control.Monad
jam f = read <$> getLine >>= \bigT -> sequence_
[putStr (concat ["Case #", show t, ": "]) >> f | t <- [1..bigT]]
main = jam $ do
[l, p, c] <- map read . words <$> getLine
let
f 1 = 0
f n = 1 + f (div (n + 1) 2)
putStrLn $ show $ f $ length $ takeWhile (<p) $ iterate (c*) l2010 Round 1C
Rope Intranet
Load Testing
This is a disguised binary search. Suppose the question had asked us to find a number between 1 and 100, where the only kind of question we may ask is "is the number greater than n?" for some n between 1 and 100. Perhaps most contestants would spot binary search instantly.
What if we were asked for the nearest mulitple of 5, and the endpoints were not integers? Again, perhaps most would spot binary search still applies, except now we need only inquire about multiples of 5 within the given range.
Then what if we replace questions and answers involving n with questions and answers involving 2n? We have now recreated the given problem.
Making Chess Boards
The chessboard is a distraction. If we XOR a given piece of bark with a m-by-n chessboard, then we see the question is asking us to repeatedly to cut out the largest square consisting of all 0s or all 1s in a given m-by-n matrix of bits.
Let us focus on the first cut: how do we find the biggest square consisting of the same bit? Without loss of generality, let’s focus on the 1-bit case.
This is a classic problem. The brute force approach would be to iterate over every possible square, each time checking if the constituent bits are all 1s. This is wasteful because we compare the same bits with each other over and over again. How can we remove this redundant work?
We notice we can quickly determine if the row and column \((r, c)\) is the top-left of a \(k \times k\) 1-bit squares if we can quickly determine if there are \((k-1) \times (k-1)\) 1-bit squares at 4 particular paris of rows and columns: \((r, c), (r, c + 1), (r + 1, c), (r + 1, c + 1)\). Thus with memoization, deciding whether a square of a given size is at a given location takes at most 4 lookups, unless it’s a 1-by-1 base case which we can immediately read from the input. For an \(N \times N\) input, this takes \(O(N^3)\) time since we must try every size between \(1\) and \(N\).
But it turns out we can do better, which I only learned after looking it up! The maximum input measures 512 by 512, so our cubic algorithm ought to be barely tolerable on typical laptops, but Google Code Jam now runs submitted solutions on their own machines with tight resource limits.
We maintain our top-to-bottom, left-to-right order of traversal, but instead of the top-left, we focus on the bottom-right, and in one shot compute the largest square whose bottom-right is at a given row and column. If there is a 0 at $(r, c)$ then it cannot be the bottom-right of a 1-bit square. Otherwise, for \(r, c > 0\) we have more than a 1x1 square only if \((r, c - 1), (r - 1, c), (r - 1, c - 1)\) all hold 1s. Furthermore, if \(f(i, j)\) denotes the side length of the largest square whose bottom right is at \((i, j)\), we have \(f(r, c) = 1 + min(f(r, c - 1), f(r - 1, c), f(r - 1, c - 1)\).
Next, we must consider the effect of cutting out the largest square with bottom-right \((r, c)\). Let its side length be \(k\). Clearly, \(f(i, j) = 0\) for all cells \((i, j)\) that were cut out. More generally, we may need to reduce \(f(i, j)\) for squares that overlap with the excised square. Since we cut out the biggest square, we need only update the \(f\) values for \(r - k < i < r + k\) and \(c - k < j < c + k\).
We also need an inverse map from chessboard size to locations of bottom-right squares so we can quickly look up the next board to cut. This map must be maintained in sync, which is a bit fiddlier than I had anticipated. Perhaps there’s a cleaner way.
import Control.Monad
import Data.List
import qualified Data.Map.Strict as M
jam f = read <$> getLine >>= \bigT -> sequence_
[putStr (concat ["Case #", show t, ": "]) >> f | t <- [1..bigT]]
main = jam $ do
[m, n] <- map read . words <$> getLine
putStr =<< solve m n . concat <$> replicateM m (concatMap (bitty . fromHexDigit) <$> getLine)
fromHexDigit c
| c >= '0' && c <= '9' = fromEnum c - fromEnum '0'
| otherwise = fromEnum c - fromEnum 'A' + 10
bitty n = [n `div` 2^(3-i) `mod` 2 | i <- [0..3]]
llookup k m = maybe [] pure $ M.lookup k m
solve m n bits = unlines $ show (length boards) : [unwords $ show <$> [head bs, length bs] | bs <- boards]
where
world = (,) <$> [1..m] <*> [1..n]
bark = M.fromList $ zip world bits
biggest = foldl' (\tab ij -> M.insert ij (grow tab ij) tab) M.empty world
grow tab (i, j)
| i > 1, j > 1, v <- bark M.! (i, j), and
[ v /= bark M.! (i - 1, j)
, v /= bark M.! (i , j - 1)
, v == bark M.! (i - 1, j - 1)
] = biggestSquare tab (i, j)
| otherwise = 1
inv = foldl' (\tab (k, v) -> M.insertWith M.union v (M.singleton k ()) tab) M.empty $ M.assocs biggest
boards = group $ cut m n bark (inv, biggest)
biggestSquare tab (i, j) = 1 + minimum
[ tab M.! (i - 1, j)
, tab M.! (i , j - 1)
, tab M.! (i - 1, j - 1)
]
cut m n bark (inv, biggest)
| M.null inv = []
| (k, v) <- M.findMax inv = let
((r, c), ()) = M.findMin v
area = (,) <$> [max 1 (r-k+1)..min m (r+k-1)] <*> [max 1 (c-k+1)..min n (c+k-1)]
biggest' = foldl' regrow biggest area
regrow tab (i, j)
| i <= r && j <= c = M.insert (i, j) 0 tab
| tab M.! (i, j) <= 1 = tab
| otherwise = M.insert (i, j) (biggestSquare tab (i,j)) tab
inv' = foldl' reprioritize inv area
reprioritize tab ij
| p' /= p = insij $ delij tab
| otherwise = tab
where
p = biggest M.! ij
p' = biggest' M.! ij
delij t
| M.size v == 1 = M.delete p t
| otherwise = M.insert p (M.delete ij v) t
where v = t M.! p
insij t
| p' == 0 = t
| Just v <- M.lookup p' t = M.insert p' (M.insert ij () v) t
| otherwise = M.insert p' (M.singleton ij ()) t
in k : cut m n bark (inv', biggest')