← back

The next greatest number, part 2

30 September 2016

Last time we calculated a solution to the next greatest number problem --- unfortunately our algorithm was not an efficient one: evaluating nextGreater xs takes O(n^2) time, as we must evaluate filter (> x) for all xs in xs.

nextGreater :: [Int] -> [Maybe Index]
nextGreater = map findGreater . init . tails . indexed
  where
    findGreater = uncons >=> uncurry (find . snd)
    find e      = headMay . map fst . filter ((> e) . snd)

In this post, we will attempt to derive a solution that matches the O(n) complexity of the imperative solution.

Dynamic programming, take one

On closer inspection, we note that a lot of repeated computation is being performed on the subproblems --- the computation on a suffix repeats the work in the suffix to follow. Indeed, the use of tails induces an optimal substructure on the computation, meaning that we can employ dynamic programming. ' If we look at the list from right to left, we can frame it as a dynamic programming problem --- given [ a : b : c ... ], the next greater element of a is either b, or the next greater element of b if b <= a.

Is this correct?

No, take the case where you have a list [ 10, 1, 2, 12 ]. 1 is not greater than 10, but the next greater element of 1 is 2, which is also smaller than 10. Instead, if b <= a you need to keep discarding the following NGE's until you find one that is greater than a. Which is basically the same solution as before.

"Dynamic programming", take two

Let's consider the problem differently, where instead of using tails and we used inits. If I have a list [a ,b, c], where b and c are not the NGE's of a, then we have to consider the elements following it, i.e. d, e... until one matches.

This suggests a single scan, linear time solution using a stack to keep track of everything that we have not found the NGE for. Then for each element in the list we. However this will cause us to emit things out of order as we aren't storing things into slots in an array.

First define the action for emitting (i.e. popping things off the stack):

emit :: [(Index,Int)] -> (Index, Int) -> ([(Index,Int)] , [(Index,Index)])
emit [] x     = ([], [])
emit stk@((i,e):ss) x@(j,e')
  | e' < e    = (stk, [])
  | otherwise = ((i,j) :) <$> emit ss x

Then we simply lift this operation over the list with a fold:

nextGreaterL :: [Int] -> [(Index,Index)]
nextGreaterL = snd . fold step ([],[]) . indexed
  where
    step (stk,ret) x = (ret <>) <$> emit stk x

This takes linear time in the worst case, and each step takes a constant amortised time.

Imperative solution

def solve(ls):
  xs, size = reduce(lambda (xs, i), x: (xs + [(x, i)], i+1), ls, ([], 0))
  answer = map(lambda x: -1, ls)
  stack = []
  for (x1, i1)  in xs:
    while len(stack) != 0:
      x2, i2 = stack.pop()
      if x2 < x1:
        answer[i2] = i1
      else:
        stack.append((x2, i2))
        break
    stack.append((x1, i1))
  return answer

print solve([1,4,10,3,5])