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

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

## 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 2^{20} 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.

*blynn@cs.stanford.edu*💡