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
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.
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)