Contents

2014 Round 1C

Part Elf

After parsing, divide P and Q by their greatest common divisor to write the fraction in lowest terms.

Vida can only be part Elf if the denominator is a power of 2. To find the most recent possible Elf in her family tree, we first find the largest power of 2 that fits in the numerator. Then the difference between the exponents is the answer.

import Jam
import Data.List
import Data.List.Split
import Data.Maybe

main = jam $ do
  [pd, qd] <- map read . splitOn "/" <$> gets
  let
    [p, q] = map (`div` gcd pd qd) [pd, qd]
    f n = fromJust $ find (\x -> 2^(x+1) > n) [0..]
  pure $ if 2^f q /= q then "impossible" else show $ f q - f p

Reordering Train Cars

We might attempt brute force as follows:

import Jam
import Data.List

main = jam $ do
  gets
  ts <- words <$> gets
  let f xs = map head (group xs) == nub xs
  pure $ show $ length $ filter (f . concat) $ permutations ts

However, this is too slow even for the small input. Because Haskell strings are lists and not arrays, concatenating permutations of strings is slower than one might expect.

It turns out the small input contains many strings with repeated characters, which we may be replaced with single characters without changing the answer:

  ts <- map (map head . group) . words <$> gets

With this, our program takes about 3 minutes.

Another bottleneck is nub, which takes quadratic time. Since we know to expect only lowercase letters, we can replace nub with a bitset:

import Jam
import Data.Bits
import Data.Char
import Data.List

main = jam $ do
  gets
  ts <- map (map head . group) . words <$> gets
  let
    f _ [] = True
    f n (c:cs) = not (testBit n k) && f (setBit n k) cs
      where k = ord c - ord 'a'
  pure $ show $ length $ filter (f (0 :: Int) . map head . group . concat) $
    permutations ts

This takes about a minute to run.

It’s unsatisfying that there are small inputs that are prohibitively slow, such as ten trains of "ababababab". We could easily detect such cases before trying permutations, or maybe we could avoid behind-the-scenes list pointer churn by permuting [1..N] and indirectly getting at the strings, but let’s just solve the large input.

As before, for each train, we replace all runs of characters with a single character (map head . group). We partition them into two groups: those consisting of a single letter, and those consisting of two or more distinct letters.

Let’s call the single-letter trains "uni-trains", and the other trains "multi-trains".

The uni map holds the factorial of the count of uni-trains for each letter, reduced to the given modulus. If a valid connection of trains exists, then copies of the same uni-train may be permuted amongst themselves, thus a uni-train appearing n times contributes a factor of n! to the final answer.

Among the uni-trains, we split off the loners: letters that only appear in uni-trains. Each non-loner uni-train letter must appear on the front or the back of one of the multi-trains, otherwise we cannot connect them while satisfying the given conditions. We check for this (badUni) and return 0 if any are found. This is the only validity check needed for uni-trains.

We look for forced moves amongst the multi-trains. As long as we find pairs of trains that can connect, that is, the front of one matches the back of another, we connect them, removing one copy of the letter while doing so.

We wind up with, say, j different strings of connected trains and, say, i loners. There are no remaining forced moves, so the (i + j)! permutations of these strings of trains are either all valid or invalid. Hence we connect the strings of multi-trains in some arbitrary order and see if it satisfies the given constraints, namely, concat js == nub (concat js).

import Jam
import Data.Array
import Data.List
import qualified Data.Map as M

mul x y = x * y `mod` 1000000007
fac = array (0, 100) $ (0, 1) : [(i, mul i (fac!(i - 1))) | i <- [1..100]]

main = jam $ do
  gets
  (as, bs) <- partition ((== 1) . length) .
    map (map head . group) . words <$> gets
  let
    uni = (fac!) <$> M.fromListWith (+) (zip (map head as) $ repeat 1)
    (loners, cs) = partition (\u -> all (notElem u) bs) $ M.keys uni
    badUni = any (\c -> any (elem c . init . tail) bs) cs
    forced ws
      | null ms = ws
      | (x, y) <- head ms = forced $ (x ++ tail y):delete x (delete y ws)
      where ms = [(x, y) | x <- ws, y <- ws, x /= y, last x == head y]
    js = forced bs
    solve
      | badUni || concat js /= nub (concat js) = 0
      | otherwise = fac!(length loners + length js) `mul` foldl' mul 1 uni
  pure $ show solve

We’ve taken advantage of the FTP proposal, which generalizes foldl' to run on anything Foldable, such as Data.Map.

Enclosure

For the small input, we use brute force: we try every layout of stones (up to 220 of these per case), and count the enclosed points with recursive 4-way flood fills.

Mutable arrays are probably better suited for flood fills, but we use standard maps anyway. Although our program is slow, it’s still fast enough for the contest, completing the small input under two minutes.

import Jam
import Data.List
import qualified Data.Map as M

main = jam $ do
  [n, m, k] <- getints
  let
    f stones = length $ filter (mm M.!) [(x, y) | x <- [1 ..n], y <- [1..m]]
      where
        mm = foldl' (\m p -> if p `M.member` m then m
          else walk m [p] []) (M.fromList (zip stones $ repeat True))
            [(x, y) | x <- [1 ..n], y <- [1..m]]

        walk a [] done = insertList a done True
        walk a (p@(x, y):ps) done
          | p `M.member` a = if a M.! p
            then walk a ps (p:done)
            else insertList a done False
          | x == 1 || x == n || y == 1 || y == m = insertList a (p:done) False
          | otherwise = walk a
            (ps ++ filter (\a -> onboard a && a `notElem` done)
            (add p <$> [(1, 0), (-1, 0), (0, 1), (0, -1)])) (p:done)

    onboard (x, y) = x >= 1 && x <= n && y >= 1 && y <= m

  pure $ show $ minimum $ map length $ filter ((>= k) . f) $
    subsequences [(x, y) | x <- [1..n], y <- [1..m]]

add (a, b) (c, d) = (a + c, b + d)

insertList a xs v = foldl' (\a k -> M.insert k v a) a xs

We first dispose of some special cases. If there is only one row or column, then we need a row or column of K stones to enclose K points. Also, if K is 4 or less the answer is simply K.

Intuitively, the most efficient solution is a single, convex enclosure whose borders are one stone thick. On an infinite board, it seems a diamond is the best shape, which leads us to seek out truncated diamonds. There are probably ways of proving this easily, but in a contest we lack time to dwell on this.

We consider a sweep-line algorithm, a trick that often works well in 2D problems. We start from a column of a stones in the leftmost column, then as we sweep to the right, we place one stone for the top border and one bottom stone for the bottom borders, then finally we finish in the last column with a column of b stones.

For example, we might go from a column of 3 stones to a column of 2 stones as follows:

..X...
.X.X..
X...X.
X....X
X....X
.X..X.
..XX..

To maximize the area within, we should have the top and bottom border stones as far as away as possible. The distance between them is limited by the number of rows. Also, each border stone must be connected orthogonally or diagonally to a stone in either adjacent column.

We also want a and b to be as close as possible; if a > b + 1, then we could decrement a, increment b, and possibly obtain greater distances between some of the top and bottom border stones without changing the total number of stones.

We’ve done enough thinking: the large input cases are small enough that the computer can do the rest. Let n be the number of columns and m be the number of rows, and if necessary, swap them so that n > m.

Then for i ← [2..n], we enumerate the largest enclosures that take exactly i columns, by taking all a ← [1..m], b ← [a - 1, a], b /= 0 and following our construction described above. We need a + b stones for the columns on either end, and 2 stones for each column in between them. As for the points enclosed, starting from the left side of a stones, we enclose a, a + 2.. points up until the halfway mark, and going from the right side of b stones we enclose b, b + 2.. points in the columns, up to halfway. In both cases the distance is limited by m, the number of rows. When there is an odd number of columns, we do an extra computation to determine the points covered in the median column.

For certain number of stones, using more columns (i.e. a higher i) would be better so we will find suboptimal enclosures. However, since we try all possible i, we find all the optimal enclosures as well, and fromListWith max ensures we only remember the best enclosures.

Once we have the list of the best enclosures, we simply find the smallest that can enclose K points.

main = jam $ do
  [mn0, mn1, k] <- getints
  let
    m = min mn0 mn1
    n = max mn0 mn1
  pure $ show $ solve m n k

solve m n k
  | k <= 4 || m == 1 = k
  | otherwise = fst $ head $ dropWhile ((< k) . snd) $ M.assocs $
    M.fromListWith max $ concat [f m i k | i <- [2..n]]

f m n k = [(a + b + 2*(n-2), g a b) | a <- [1..m], b <- [a - 1, a], b > 0]
  where
    (q, r) = divMod n 2
    g a b = sum [min m (a + (i - 1) * 2) +
                 min m (b + (i - 1) * 2) | i <- [1..q]]
          + if r == 0 then 0 else min m $ b + 2 * q

The brute force solution paid off: the first time around, I neglected some special cases, so my newer program failed on the small input. This would have saved me in a contest.

Contents
Ben Lynn blynn@cs.stanford.edu 💡