Contents

2008 Round 1C

Text Messaging Outrage

The obvious solution works. Sort the frequencies from largest to smallest, then repeatedly assign them k at a time to the keys, padding with 0s if the number of frequencies is indivisible by k. The cost of each starts at 1 press, and goes up each iteration.

import Data.List
import Jam

main = jam $ do
  [_, k, _] <- getints
  fs <- sortBy (flip compare) <$> getints
  let
    f acc cost rest = case splitAt k rest of
      (0:_,  _) -> acc
      ( as, bs) -> f (acc + sum as * cost) (cost + 1) bs
  return $ show $ f 0 1 $ fs ++ repeat 0

Ugly Numbers

As the problem description reveals, the brute force solution is exponential. Instead, we employ dynamic programming, and the inclusion-exclusion principle.

Given a string s of length n and a positive integer m, define f n r to be the number of ways of inserting plus or minus signs into the suffix of length n of s so that the resulting expression is r modulo m. Define g k to be the number represented by the prefix of length k of s modulo m.

For a suffix, we can choose to insert no signs, which accounts for 1 or 0 ways, depending on whether g n == r. Otherwise, we can choose to insert a plus or minus sign after k ← [1..n - 1] characters, which leads to the recursion:

f n r = fromEnum $ (if g n == r then 1 else 0)
   + sum [f (n - k) r0 + f (n - k) r1 | k <- [1..n - 1]
         , let r0 = (r - g k) `mod` m
         , let r1 = (-r0) `mod` m]

To make this fast enough, we memoize, that is, we cache f n r the first time we compute it and look it up every subsequent time it’s needed. We use the ST monad to avoid probihitively expensive array copying.

Next, we apply inclusion-exclusion: briefly, summing f n 0 for m ← [2,3,5,7] double-counts expressions that are divisible by the product of two of these primes, such as 2 * 3 = 6, so we subtract f n 0 for

m <- [p * q | p <- [2, 3, 5, 7], q <- [2, 3, 5, 7], p /= q]

but this subtracts one too many for those expressions that are divisible by products of three of these primes, and so on. We use filterM on the list monad to enumerate all subsets of a set.

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.List
import Data.Char
import Jam

tally s m = runST $ do
  memo <- newListArray ((1, 0), (length s, m - 1)) $ repeat (-1)
      :: ST s (STUArray s (Int, Int) Int)
  let
    modread = foldl' (\r c -> (10 * r + digitToInt c) `mod` m)  0
    f s r = let n = length s in do
      v <- readArray memo (n, r)
      if v >= 0 then return v else do
        x <- foldl' (liftM2 (+)) (return $ fromEnum $ r == modread s)
          [ (+) <$> f s1 r0 <*> f s1 ((-r0) `mod` m) | k <- [1..n - 1]
          , let (s0, s1) = splitAt k s
          , let r0 = (r - modread s0) `mod` m
          ]
        writeArray memo (n, r) x
        return x
  f s 0

main = jam $ do
  s <- gets
  return $ show $ sum [-(-1)^(length ts) * tally s (product ts)
      | ts <- filterM (const [True, False]) [2, 3, 5, 7], ts /= []]

Small but important optimizations are strict left folds, and reducing by m digit by digit instead of reading an entire arbitrary precision integer.

We can memoize far more easily by having a library do the hard work:

import Data.MemoTrie

tally str m = let
  modread = foldl' (\r c -> (10 * r + digitToInt c) `mod` m) 0
  g n = drop (length str - n) str
  f (n, r) = foldl' (+) (fromEnum $ r == modread (g n))
      [ mf (n - k, r0) + mf (n - k, (-r0) `mod` m) | k <- [1..n - 1]
      , let (s0, s1) = splitAt k $ g n
      , let r0 = (r - modread s0) `mod` m
      ]
  mf = memo f
  in mf (length str, 0)

Nonetheless, manually memoizing our function is good training. Furthermore, it can be faster because for example we know we can use a fixed array rather than growing a trie, and in some problems, additional complications force us to do everything ourselves.

Increasing Speed Limits

Finding a longest increasing subsequence is a classic dynamic programming problem, and one we encountered in another competition. I thought counting all increasing subsequences would be similar.

Thus I arrived at the following O(N2) method. First replace the numbers with their ranks, and let a be the list containing them. Then define f n m to be the number of increasing subsequences in the last n elements of the sequence that begin with m or higher. We find that:

f n m | m <= r = f (n-1) m + f (n-1) (r+1) + 1
      | m  > r = f (n-1) m
      where r = (reverse a)!!n

However, after a long struggle, I concluded I must lack knowledge of the right algorithm to solve this problem efficiently.

I searched for "all increasing subsequences", and confirmed my suspicions: it turns out the trick is to use Fenwick trees aka binary indexed trees. I had never heard of them, which is possibly due to my age: they were published in 1994 so are absent from my textbooks. We’ll outline them briefly here.

Suppose there are n initially empty boxes, and there are two operations we do frequently:

  • Add m balls to box k.

  • Find the total number of balls in the boxes [1..k].

What data structure should we use? The obvious choice is an array of size n where the k`th entry holds tne number of balls in box `k. Then adding m balls to box k takes constant time, while summing the first k boxes takes linear time.

Another possibility is to store cumulative counts in the array, that is the k`th entry holds the sum of boxes `[1..k]. Returning the sum of the first k boxes is now a constant operation, but when adding balls to box k, we take linear time updating the last n - k + 1 array entries.

Fenwick trees lie somewhere in between. They are cleverly designed so that both operations take O(log N) time. Suppose we want the sum of the boxes [1..25]. Now, 25 is 11001 in binary, and going right to left, if we change the 1s to 0s one by one, we end up with the numbers 11000, 10000, and finally 0, which we ignore. In decimal, we have 25, 24, and 16. Then the answer is the sum of elements in boxes 25, 24 and 16. We leave it as an exercise to figure out how to add balls to a box.

Both operations require finding the last nonzero bit in a number. We use a well-known bit twiddling trick for this.

import Data.Bits
import Data.Ord
import Data.Monoid
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import Jam

m07 = (`mod` 1000000007)

lsb n = (n `xor` (n - 1)) .&. n

sumidxs = unfoldr (\k -> if k == 0 then Nothing else Just (k, k - lsb k))

insidxs k n = unfoldr (\k -> if k > n then Nothing else Just (k, k + lsb k)) k

main = jam $ do
  [n, m, x, y, z] <- getints
  _as <- getsn m
  let
    bs = gen 0 (listArray (0, m - 1) $ read <$> _as)
    cs = snd <$> sortBy (comparing fst <> comparing ((0-) . snd)) (zip bs [1..])
    gen i as
      | i == n = []
      | True   = let j = mod i m in
          (as!j):gen (i+1) (as // [(j, (x*as!j + y*(i+1)) `mod` z)])

  return $ show $ runST $ do
    xs <- newListArray (1, n) $ repeat 0 :: ST s (STUArray s Int Int)
    forM_ cs $ \k -> do
      t <- foldl' ((m07 .) . (+)) 0 <$> mapM (readArray xs) (sumidxs k)

      forM_ (insidxs k n) $ \i ->
        readArray xs i >>= writeArray xs i . m07 . ((t + 1) +)

    foldl' ((m07 .) . (+)) 0 <$> mapM (readArray xs) (sumidxs n)
Contents
Ben Lynn blynn@cs.stanford.edu 💡