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)