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.

Alien Numbers

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

Always Turn Left

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.

Egg Drop

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]

Shopping Plan

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)

Ben Lynn blynn@cs.stanford.edu 💡