2008 Practice Problems
I play-tested the Practice Problems with C, while a friend used Python. I was handily beaten: I recall being slowed down by trivial printf and scanf bugs, and later running into a larger roadblock when I realized I needed multiprecision arithmetic.
Until then, I thought I was fast at typing administrative details like declarations, semicolons, ampersands, memory allocations, and so on. I was confident the cost was negligible. But the devil was in the details: in the end I was trounced precisely because they got in my way.
My dismal performance shook me out of an illogical mindset that I perhaps inherited from the 1980s. Although the contest was happy with, say, a program that took one minute to solve a problem, for some reason, I wanted my programs to be so fast that small cases finish instantly from a human’s perspective. Even on the latest hardware, popular scripting languages can take half a second just to start up, so I was stuck with C.
With Haskell, I can have my cake and eat it too: lack of bookkeeping and boilerplate means I can focus on algorithms, yet I still have type safety and fast compiled code. If only I knew then what I know now.
The problem description is a cute way of saying we want to convert from one base to another. We could maybe use unfoldr with divMod to convert to the second base, which would prettily complement the fold used to convert from the first base, but this might be more verbose.
The sole job of one helper function is to handle 0 correctly, where we wish to print the zero digit instead of the empty string.
import Jam import Data.List import Data.Maybe main = jam $ do [n, s, t] <- words <$> gets let i = foldl' (\x c -> x * length s + fromJust (c `elemIndex` s)) 0 n f 0 = [head t] f x = g x g 0 = "" g x = g (x `div` length t) ++ [t!!(x `mod` length t)] return $ f i
I forget if I ever got around to programming this in C or not, but I’m sure glad I’m using Haskell this time around!
The algorithm is straightforward. We imagine we have a pen and paper with grid lines. We start at some point on the grid which we label (0, 0), and trace out the path from entrance to exit. Along the way, we mark the walls that our left hand touches. For example, if we walk straight ahead, then there must be a wall to our left, while if we turned right twice before walking straight ahead, then there must be three walls, one in every direction except for the way we entered the square.
After tracing the path, we know the location of the exit of the maze, and its direction, so we can simply reverse direction and follow the path from the exit to the entrance, and again mark the walls touched by our left hand as we go.
The conditions of the problem imply that we have touched every wall in the maze at least once by now, so we finish by printing the walls we found.
import Jam import Data.Bits import Data.List import Data.List.Split import qualified Data.Map as Map import Data.Maybe import Numeric [north, south, west, east] = map (2^) [0..3] :: [Int] hand (1, 0) = east hand (-1, 0) = west hand (0, 1) = north hand (0, -1) = south main = jamLnCat $ do [s0, s1] <- words <$> gets let f (x@(r, c), d@(dr, dc), as) step = case step of "" -> g d [h d] "L" -> g (-dc, dr)  "R" -> g ( dc, -dr) [h (dr, dc), h (dc, -dr)] "RR" -> g (-dr, -dc) [h (dr, dc), h (dc, -dr), h (-dr, -dc)] where g (dr, dc) bs = ((r + dr, c + dc), (dr, dc), bs ++ as) h d = (x, hand d) (x0, (dr0, dc0), as) = foldl' f ((0, 0), (1, 0), ) $ endBy "W" s0 (_, _, bs) = foldl' f (x0, (-dr0, -dc0), ) $ endBy "W" s1 m = Map.fromListWith (.|.) $ concatMap init [as, bs] r0 = minimum $ fst <$> Map.keys m c0 = minimum $ snd <$> Map.keys m r1 = maximum $ fst <$> Map.keys m c1 = maximum $ snd <$> Map.keys m pure $ unlines [concatMap (\n -> showHex (15 - n) "") [fromMaybe 0 $ Map.lookup (r,c) m | c <- [c0..c1]] | r <- [r0..r1]]
We use a Data.Map to store the squares of the grid as we walk across them. Later, we find the minimum and maximum of the rows and columns, and iterate on all values in their ranges to print the walls. Some care is needed because a square may have no walls in which case it is absent from the map: we handle this by calling fromMaybe 0 on the results of lookup.
Each map entry holds an Int whose bits represent the walls that are present. The directions are ordered according to the table given in the problem.
The endBy function of Data.List.Split coupled with pattern matching yields succinct, clear code to handle the different kinds of turns and the following step.
There’s little else to describe. The h function takes the direction we are currently facing and marks the wall touched by the left hand. The g function turns to the given direction, takes one step, and also accumlates the given walls into a list. We use fromListWith along with a bitwise OR to convert this list into the map described above.
This problem builds on a famous question reputedly encountered by programmers interviewing for a job.
The solution hinges on a simple recurrence. Let fmax d b be the maximum number of floors we can distinguish with at most d drops and allowing up to b breaks.
Suppose we drop our first egg from floor f. If it breaks, we know the highest floor from which we may safely drop an egg is less than f and furthermore we have d - 1 remaining drops and b - 1 remaining breaks to find it.
On the other hand, if the egg remains intact then we know the critical floor is strictly above f, and we have d - 1 remaining drops and b remaining breaks to find it. Thus we have:
fmax d b = fmax (d - 1) (b - 1) + 1 + fmax (d - 1) b
As for the base cases: if we have no remaining drops or breaks then we are forbidden to drop any eggs, so we learn nothing:
fmax 0 _ = 0 fmax _ 0 = 0
With memoization, we can solve the small input:
import Jam import Data.Bool import Data.MemoTrie fmax :: Integer -> Integer -> Integer fmax _ 0 = 0 fmax 0 _ = 0 fmax d b = mfmax (d - 1) (b - 1) + 1 + mfmax (d - 1) b mfmax = memo2 fmax main = jam $ do [f, d, b] <- getintegers let n = fmax d b pure $ unwords $ show <$> [ bool (-1) n (n < 2^32), head $ dropWhile ((< f) . (`fmax` b)) [0..], head $ dropWhile ((< f) . fmax d) [0..]]
For the large input, we handle a few cases specially. Firstly, when we may break at most one egg, the only possible course of action is to drop the egg on every floor until it breaks, starting from floor 1 and moving up:
fmax d 1 = d
Secondly, if we have two egg breaks available, then if we have more than sqrt(2 * 2^32) drops available, then we can handle over 2^32 floors. One can prove this, or write a program to find that 92682 is the limit:
head [d | d <- [0..], fmax d 2 >= 2^32]
Since more available breaks means even higher floor limits, we have fmax d b = -1 for d > 92681 and b > 1.
Lastly, we check as early as possible for floor limits that are at least 2^32.
import Jam import Data.MemoTrie fmax _ 0 = 0 fmax 0 _ = 0 fmax d 1 = d fmax d b | d > 92681 = -1 | x == -1 || y == -1 = -1 | otherwise = if z < 2^32 then z else -1 where x = mfmax (d - 1) (b - 1) y = mfmax (d - 1) b z = x + 1 + y mfmax = memo2 fmax main = jam $ do [f, d, b] <- getintegers let least g = head $ dropWhile (\n -> g n /= -1 && g n < f) [0..] pure $ unwords $ show <$> [fmax d b, least (`fmax` b), least $ fmax d]
For now, assume there are no perishable items. We must find the optimal order and locations to buy them. This is somewhat like the Travelling Salesman Problem in that we can use dynamic programming to improve on the naive algorithm by recursing on subsets instead of permutations of subsets.
Define f items pos to be the mininum cost of buying each member of items starting from the position pos then returning home. Then:
f items pos = minmium [dist pos j + price + f (delete i items) j | i <- items, (j, price) <- sellersOf i]
That is, for each member i of items and for each store j that sells i, we consider buying i at store j first then buying the rest. Then the optimal way to buy items is the cheapest of these options. Here, the dist function multiplies the distance between two given positions by the cost of gas.
Perishable items add a wrinkle to the algorithm. We must remember whether we just bought a perishable item along with the items we have already bought and our starting position, that is, we now consider a cost function with three parameters:
f (items, perishable, pos)
If perishable, then we either go home before buying the next item:
[dist pos home + dist home j + f (delete i items, isPerishable i, j) i <- items, (j, price) <- sellersOf i]
or we can buy another item at the current store:
[f (delete i items, True, pos) + price | i <- items, sells pos i]
We use a bitset to represent items, with 0 represent those we wish to acquire. The iMap maps items to lists of (store, price) tuples. The position is an index into a vector holding each store’s location, except for -1 which represents the origin.
As usual, Data.MemoTrie takes care of top-down memoization. The program is barely fast enough, taking 7 minutes to run on my laptop. A bottom-up array may be faster to build.
import Jam import Data.Bits import Data.List import Data.List.Split import qualified Data.Map as Map import Data.Maybe import Data.MemoTrie import qualified Data.Vector as V import Data.Vector ((!)) toNum = read :: String -> Double parseItem tab s = let [item, price] = splitOn ":" s in (fromJust $ elemIndex item tab, toNum price) parseStore tab s = let (xpos:ypos:items) = words s in ((toNum xpos, toNum ypos), Map.fromList $ parseItem tab <$> items) main = jam $ do [n, m, gasInt] <- getints items <- words <$> gets let gas = fromIntegral gasInt d (x0, y0) (x1, y1) = gas * sqrt ((x1 - x0)^2 + (y1 - y0)^2) tab = map (reverse . dropWhile (== '!') . reverse) items willPerish = V.fromList $ map ((== '!') . last) items stores <- V.fromList . map (parseStore tab) <$> getsn m let iMap = Map.fromListWith (++) [(i, [(j, price)]) | j <- [0..m - 1], (i, price) <- Map.assocs $ snd $ stores!j] dist j k = d (coords j) (coords k) coords (-1) = (0, 0) coords j = fst $ stores!j f (bits, perishable, pos) | bits == 2^n - 1 = dist (-1) pos | perishable = foldl1' min $ [dist pos (-1) + dist (-1) j + mf (bits + 2^i, willPerish!i, j) + price | i <- others, (j, price) <- iMap Map.! i, j /= pos] ++ [mf (bits + 2^i, True, pos) + price | i <- others, price <- maybeToList $ Map.lookup i $ snd $ stores!pos] | otherwise = foldl1' min [dist j pos + mf (bits + 2^i, willPerish!i, j) + price | i <- others, (j, price) <- iMap Map.! i] where others = filter (not . testBit bits) [0..n - 1] mf = memo f pure $ show $ mf (0 :: Int, False, -1)