-- codejam.hs module CodeJam (codeJam, codeJamLiner, mrw) where -- For Code Jam problems with unusual inputs. -- Splits the input into lines, but the rest is up to the user. codeJamWith :: ([String] -> [String]) -> IO () codeJamWith f = interact $ unlines . zipWith (++) ["Case #" ++ show t ++ ": " | t <- [1..]] . f . lines -- For Code Jam problems where the first line contains the number of cases. -- The given function should take an input s and return a tuple (r, t) where -- r is the remaining unparsed input and t is the answer for the first case -- in the string s. codeJam :: ([String] -> ([String], String)) -> IO () codeJam f = codeJamWith $ let jamf _ [] = [] jamf f s = let (r, t) = f s in t : jamf f r in jamf f . tail -- For Code Jam problems where each case fits on a single line. codeJamLiner :: (String -> String) -> IO () codeJamLiner f = codeJam (\(x:xs) -> (xs, f x)) -- We seem to need `map read . words` often. mrw :: Read a => String -> [a] mrw = map read . words
Code Jam for Veterans 2013
Before we tackle the Code Jam for Veterans 2013, let’s reduce code duplication. So far, every Code Jam problem wants us to print "Case #x:" before each answer.
The inputs also have much in common. All consist of lines of text. Apart from Alien Language, the first line contains the number of test cases. Several expect one input case per line, and several expect space-separated numbers indicating how many more lines to read for a given test case.
With this in mind, we whip up the following Haskell module:
Now we can solve Reverse Words with:
-- strawberry.hs import CodeJam main = codeJamLiner $ unwords . reverse . words
When compiling, we tell ghc the module filename:
$ ghc strawberry codejam.hs
Hedgemony
We translate the English description of the gardener’s routine to Haskell.
We explicitly declare ns to be of type [Double] to avoid ambiguity.
import Text.Printf import CodeJam main = codeJam $ \(_:_ns:s) -> let ns = mrw _ns :: [Double] f (a:b:c:xs) = let h = min b ((a + c)/2) in if null xs then h else f (h:c:xs) in (s, printf "%.6f" $ f ns)
Baby Height
Parsing with lists is a little clumsy, but this problem is simple enough that it’s bearable.
We postpone the division by 2 until the last minute, which means instead of
subtracting and adding 4 to get the lower and upper bounds, we subtract and add
8. Since we want the ceiling of the lower bound, we add one to it before
calling div.
import Data.List import CodeJam inches s = let (f, (_:s')) = break (== '\'') s (i, _) = break (== '"') s' in 12 * read f + read i pr n = show (n `div` 12) ++ "'" ++ show (n `mod` 12) ++ "\"" main = codeJamLiner $ \(gender:' ':_hts) -> let (_h0, _h1) = break (== ' ') _hts h = sum ( map inches [_h0, _h1] ) + if gender == 'B' then 5 else -5 in pr ((h - 8 + 1) `div` 2) ++ " to " ++ pr ((h + 8) `div` 2)
Ocean View
This is a fanciful retelling of the longest increasing subsequence problem, but even if we’re unaware of this, the other two problems are easy enough that in a real contest we would likely have ample time to derive a decent algorithm from scratch. Let’s see how we might proceed.
The houses are in a row, and the view from each house can only be blocked by the houses in front of it. This suggests dynamic programming might do the trick: something about the first n houses might tell us the answer for the first n+1 houses.
Suppose we know the solution for the first n houses is f(n), that is, f(n) is the minimum number of houses we need to destroy if the problem consisted of the first n houses only. Does that help with computing f(n+1)?
Well, if house n+1 is taller than all the other houses that are still standing in a best solution for the first n houses, then it’s easy: we keep house n+1 so f(n+1) = f(n). If not, then f(n+1) = f(n) + 1, because we could destroy house n+1, or perhaps we there’s a way to destroy f(n) + 1 houses among the first n houses so we can keep house (n+1).
There’s no way we can tell which of f(n) or f(n) + 1 is right if we only remember just the number of houses destroyed. At the least, we must somehow track the height of the tallest house in a valid sequence.
This inspires us to define f(n, m) to be the minimum number of houses we must destroy among the first n houses so that all houses have an ocean view and the height of the tallest house is m. If no such sequence exists (because no house of height m exists), then we define f(n, m) to be infinity, with one exception: we set f(0, 0) = 0 for the base case (in an empty town, we consider the lake to be a building of height 0).
Then f(n+1, m) is the minimum of f(n, m) + 1 (we destroy house n+1 or the previous maximum to maintain a valid sequence) and f(n, i) for all i < m (we keep the previous best sequence and house n + 1 has height m).
This is the recursion we’ve been looking for. We’ll tweak it slightly: we compute the number of houses we keep rather than the number of houses we destroy. Firstly, this makes the problem corespond more directly to the longest increasing subsequence problem, and secondly, when there is no house of height m, it is more natural to say that the longest subsequence of houses with maximum height m is 0 rather than deal with infinity.
With this alternate viewpoint, f(n+1, m) is now the maximum of f(n, m) and f(n, i) + 1 for all i < m, where m is the current house being considered, and our final answer is N - max f(N, i) over all i. The base case is f(0, i) = 0 for all i.
I deliberately started with the more awkward recursion to simulate what may happen in a contest. An idea may lead to a valid albeit ugly solution. Depending on time constraints, it may be best to forge ahead anyway.
import CodeJam import Data.Array import Data.List main = codeJam $ \(_:_ns:s) -> let ns = mrw _ns f [] a = length ns - maximum (elems a) f (h:hs) a = f hs $ a // [(h, foldl1' max (a!h:[a!i + 1 | i <- [0..h-1]]))] in (,) s $ show $ f ns $ listArray (0, maximum ns) $ repeat 0
To avoid a bloated stack, we use foldl1' max instead of
maximum on one of the lists. In general, we should prefer foldl'
to foldl, foldl1' max to maximum, and so on, but for small lists, it’s
reasonable to use the lazy variant for convenience and readability.
We only need one row of the array at a time so a one-dimensional array is
enough.
We could improve the algorithm further (look it up!), but there’s no need.
Alternatives
We chose arrays because (//) is handy notation for updating one element.
Still, a solution using lists is nicer in other ways:
import CodeJam
import Data.List
main = codeJam $ \(_:_ns:s) -> let
ns = mrw _ns
f [] a = length ns - maximum a
f (h:hs) a = f hs $ x ++ (foldl1' max (m:map (+1) x):y)
where (x, m:y) = splitAt h a
in (,) s $ show $ f ns $ take (maximum ns + 1) $ repeat 0
Because the longest increasing subsequence problem is so well-known, we skipped coding a brute force solution for the small input. However, it’s good training to write one:
import CodeJam import Data.List import Data.Maybe del ns@(a:as) k | k == 0 = [ns] | length ns == k = [[]] | otherwise = [(a:bs) | bs <- del as k] ++ del as (k - 1) isInc ns = and $ zipWith (<) ns (tail ns) main = codeJam $ \(_:_ns:s) -> let ns = mrw _ns :: [Int] in (,) s $ show $ fromJust $ find (or . map isInc . del ns) [0..]