Round 2’s problem C “Hidden Pancakes”, has us counting pancake stack orderings given an observation of how adding them one by one changed the external view.

Distinct-sized pancakes are piled on a plate, one by one. Each time a pancake is added to the pile, one of two things happens:

• either it is smaller than the topmost pancake, and there is one more pancake visible from above,
• or it is bigger than one or more (possibly all) of the visible pancakes, and obscures them so that there are as many or fewer resulting pancakes visible from above.

Since the pancakes’ sizes are known to be the first \(N\) naturals, we can attempt to assign a size to every one as it is added, check the constraints, and backtrack as necessary. This translates quite naturally as a fold in the Haskell list monad:

backtrack :: Int -> [Int] -> Int
backtrack n = length . foldM add (0,[],IntSet.empty)
  where
    add (v,vss,cl) v' = case compare v' (v+1) of
      GT -> mzero
      EQ -> do
        s <- lower vss
        guard (s `IntSet.notMember` cl)
        pure (v',s : vss,IntSet.insert s cl)
      LT -> do
        let vss' = drop (v - v') vss
        s <- higher vss'
        guard (s `IntSet.notMember` cl)
        pure (v',s : tail vss',IntSet.insert s cl)

The folding function add takes a current state triplet of:

1. current number of visible pancakes
2. sizes of the currently visible pancakes
3. “closed” set of sizes already allocated

At each iteration, it deduces a pancake’s relative size to the previous one’s. If the pancake is smaller, it is allocated a size lower than all visible pancakes, which simplifies as a size lower than the topmost pancake’s. If the pancake is larger, we count how many pancakes are hidden, and allocate a size between the biggest pancake covered’s and the smallest pancake not covered’s.

With easy special cases to account for the stack’s foundation:

    lower [] = [1..n]
    lower (s:_) = [1..s-1]

    higher [s] = [s+1..n]
    higher (a:b:_) = [a+1..b-1]

You’ll have noticed I’m not even bothering to take the mod. We’re counting the possibilities one by one here; if it gets anywhere near \(10^9+7\), it’s out of reach to this algorithm anyway.

But it’s enough¹ for \(N\le 13\) as is the case for the small case. For the large case, we’ll have to get more crafty.

What’s really killing the complexity is the fact we commit to a pancake’s size as soon as we see it, and never adjust it in relation to those that pile on it afterwards without cancelling the entire covering. So let’s try to refine our knowledge representation.

The exact information we get from an added pancake is always the same: an increase in number of visible pancakes means, in a very “if and only if” sense,² that its size is strictly less than that of the stack top; its conservation or decrease means that its size is between those of the biggest covered and smallest uncovered.

In other words, we’ve got an induced partial order.

The one depicted above isn’t very interesting:

• that \(p_1 \rightarrow p_2\) edge is redundant: it’s implied by those going through \(p_3\).
• it’s got a single topological ordering.

Let’s start again, this time with a test that requires a bit more on the ordering front: 1 2 3 2 3.

The first three pancakes have a trivial ordering: \(p_1 > p_2 > p_3\). Pancake 4 hides two of those, so \(p_4 > p_2 \, (> p_3)\). It failed to cover \(p_1\), so \(p_1 > p_4\). So the \(p_1 > p_2\) relation we had earlier is now redundant.

Redundant edges create cycles in our ordering’s graph, we’d like to avoid that. And we can: by only generating the edges when a “covering” pancake comes up. Oh, and also at algorithm termination, when we know no edge is going to be made redundant anymore.

We can revisit our fold from the previous implementation. This time we aren’t going to store pancake sizes, since we’re not allocating them. Instead we’ll keep the nodes of our graph in construction.

Let’s see how the process would go. We’re maintaining a stack of visible pancakes, represented as a double-bordered ellipses. They’re ordered by size when directly on the stack. Sometimes an added pancake would break that invariant. We’ll resolve it by making the part of the stack it hides, in a solid blue box, its children. Those nodes within the box are stack-ordered, so they are aggregated the other way round, by making the top-most element, in a dashed blue box, a child of the element below it.

1. We have a new visible pancake. We stack it.
2. We have a new visible pancake. We stack it.
3. We have a new visible pancake. We stack it.
4. We have one fewer visible pancakes. This means we’re covering up two stack positions (the blue box). We want to eliminate those from the stack, making them children of the currently inserted pancake. They’re visible on the stack, so their relative ordering is known. The resulting stack is two elements high. (Double-line borders indicate the nodes that form the stack.)
5. We have a new visible pancake. We stack it.
6. We have no further pancakes, so we can wrap up the stack contents. As previously, its internal ordering is known, and accounted for.

So a solid blue box means “this subtree is to be made a child of the node above it in the stack”, and a dashed blue box “this subtree is to be made a child of the node below it on the stack”.

Let’s code it.

type Stack = (Int,[Tree ()])

process :: Stack -> Int -> Maybe Stack
process (v,s) v' = case compare v' (v+1) of
  GT -> Nothing
  EQ -> Just (v',Node () [] : s)
  LT -> let (covered,s') = splitAt (v - v' + 1) s
        in Just (v',Node () [cover covered] : s')

We’ve moved to the Maybe monad to handle the case where the input is inconsistent.³ The core is still the same: a comparison of two consecutive visible pancake counts. When that count increases by one (the EQ case), we pile a new node up. When it remains or decreases, we extract the covered part of the stack, make a comb tree out of it and make it a child of the new node. That last functionality is also needed when we’re done with new input, so it’s factored out to a separate function:

cover :: [Tree ()] -> Tree ()
cover (t : Node r f : ts) = cover (Node r (t:f):ts)
cover [t] = t

So we’ve constructed a tree⁴ of all known “greater than” relations from the input. That doesn’t answer the question, though: how many orderings fit?

This can be tackled recursively.

• If the node has no children, there’s only a single ordering.
• If the node has a single child, there are exactly as many orderings as the child has: the parent node will always be in the same relative position to them (namely: above).
• If the node has two children… this is where it gets interesting. We have no way to compare any element of subtree \(T_1\) with one of the other subtree, \(T_2\). So both orderings are possible, and have to be counted in. How many are there, taking all elements into account?
  The combinatorial vision that works is the following: we take an ordering \(O_1\) of one subtree and \(O_2\) of the other. It results in an ordering \(O\) of both, whose size is the sum. The resulting ordering is determined exactly by where in the resulting ordering the elements of one subtree are. This is because the other elements are necessarily from the other ordering, and the elements’ order is given by the ordering they come from.
  So \(O_1\) and \(O_2\) generate \(C_{n_1+n_2}^{n_1}\) orderings of \(O\).⁵⁶ So \(T_1\) and \(T_2\) generate that, times the number of orderings of \(T_1\), times the number of orderings of \(T_2\).
• If the node has more children than that… well, can it? We have two cases of creating a node child: one with a solid box below, and one with a dashed box above. Both can happen to a single node, but no more.
  So our tree is indeed binary.

We need the tree’s size along when computing, so we’ll report it along with the number of orderings. Our complete tree counting function thus looks like this:

count :: () -> [(Int,Int)] -> (Int,Int)
count () [] = (1,1)
count () [(c,n)] = (c,n+1)
count () [(c1,n1),(c2,n2)] = (combinations (n1+n2) n1 *% c1 *% c2,1+n1+n2)

We’ve got \(O(N)\) combinations to compute, we do have to take care not to compute them too inefficiently. Precomputing factorials and inverse factorials up to \(N\) modulo \(10^9+7\) achieves that.

m :: Int
m = 1000000007

(*%) :: Int -> Int -> Int
(*%) = ((`mod` m) .) . (*)
infixl 8 *%

combinations :: Int -> Int -> Int
combinations n k = fact!n *% invFact!(n-k) *% invFact!k

nFact :: Int
nFact = 100000

fact :: Vector Int
fact = V.scanl (*%) 1 $ V.generate nFact succ

invFact :: Vector Int
invFact = V.scanr (*%) 716327852 $ V.generate nFact succ

That magic number in the last line is the inverse factorial of 100 000.⁷

We’ve got all we need to summarize the process with a few folds.

solve :: [Int] -> Int
solve =
  maybe 0 .
  (fst . foldTree count . cover . snd) . 
  foldM process (0,[])

So the entire process is \(2×100\,000\) multiplications and modulos of precomputation; then \(O(N)\) of tree construction and folding. All in all \(O(N)\) time and space.

And that’s all there is to it. Here’s the CodeJam wrapper for completeness.

main :: IO ()
main = do
  t <- readLn :: IO Int
  forM_ [1..t] $ \i -> do
    n <- readLn
    vs <- map read . words <$> getLine
    let answer | n <= 13   = backtrack n vs
               | otherwise = solve vs
    putStrLn $ "Case #" ++ show i ++ ": " ++ show answer

This concludes today’s problem. GitHub link. See you soon to conclude round 2!