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
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.
Ugly Numbers
As the problem description reveals, the brute force solution is exponential. Instead, we employ dynamic programming, and the inclusionexclusion 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 inclusionexclusion: briefly, summing f n 0
for
m ← [2,3,5,7]
doublecounts 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(N^{2}) 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 (n1) m + f (n1) (r+1) + 1  m > r = f (n1) 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 boxk
. 
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 wellknown 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)