apply window function to get a recursive list, how can I do?

Question

I just come across a challenging problem (from programming competition practice) that contain recursive sequence as following

given 3 numbers m n k find element a[k] where

a[0] = m
a[1] = n
a[i] = a[i-1] + a[i-2] ; if floor(i/2) mod 2 = 1
a[i] = a[i-1] - a[i-4] ; if floor(i/2) mod 2 = 0

example case: for m=2 n=3 k=6 answer would be 9

a[0] = 2
a[1] = 3
a[2] = 3 + 2 = 5
a[3] = 5 + 3 = 8
a[4] = 8 - 2 = 6
a[5] = 6 - 3 = 3
a[6] = 3 + 6 = 9
...

this is how I generate the sequence (which obviously consume lots of stack and super slow even for the first 100 element)

 1 fbm :: Int → Int → Int → Int
 2 fbm m n 0 = m
 3 fbm m n 1 = n
 4 fbm m n x = let a = fbm m n (x-1)
 5                 b = fbm m n (x-2)
 6                 c = fbm m n (x-4)
 7             in case (x `div` 2) `mod` 2 of
 8                 1 →  a + b
 9                 0 →  a - c
10 
11 fbs m n = map (λx→fbm m n x) [0..]

Since the problem required to find element at big (~1000+) index. I try to do a different approach by trying to limit computation only on function with 4 inputs and apply the function with 4 element window recursively on the list but can't success implementing any of them (something mean I can't figured out how to do it)

fs1 = map fst $ iterate next (a,b)
  where next (a,b) = something

fs2 = m:n:scanl (gen) 2 fs2 
  where gen [a,b,c,d] = something

fs3 = scanl (genx m n 0 0) (repeat 0)
  where genx a b c d = something

Question 1: Does any of my approach the good way to solve this problem? (+ please show me an example of how to do it)

Question 2: How would you solve this kind of problem if I am in the wrong way?

Answer 1

This problem is similar to "Fibonacci series", but in my opinion, there is a big difference between them.
Memoization is a common technique to solve this kind of problems.
For example, we can use it to compute Fibonacci series.
The following is a very simple illustration. It is not as good as that zipWith solution, but it is still a linear operation implementation.

fib :: Int -> Integer
fib 0 = 1
fib 1 = 1
fib n = fibs !! (n-1) + fibs !! (n-2)

fibs :: [Integer]
fibs = map fib [0..]

If we try to imitate the above fib and fibs, perhaps we would write the following code.

fbm :: Int -> Int -> Int -> Int
fbm m n 0 = m
fbm m n 1 = n
fbm m n x = let a = fbs m n !! (x-1)
                b = fbs m n !! (x-2)
                c = fbs m n !! (x-4)
            in case (x `div` 2) `mod` 2 of
                   1 ->  a + b
                   0 ->  a - c

fbs :: Int -> Int -> [Int]
fbs m n = map (fbm m n) [0..]

But the above fbs is also super slow. Replacing list by array makes little difference. The reason is simple, there is no memoization when we call fbs. The answer will be more clear if we compare the type signatures of fibs and fbs.

fibs :: [Integer]
fbs :: Int -> Int -> [Int]

One of them is a list of intergers, while the other is a function.
To let memoization happen, we have to implement fbs in anothing way.
e.g.

fbs m n = let xs = map fbm [0..]
              fbm 0 = m
              fbm 1 = n
              fbm x = let a = xs !! (x-1)
                          b = xs !! (x-2)
                          c = xs !! (x-4)
                      in case (x `div` 2) `mod` 2 of
                             1 ->  a + b
                             0 ->  a - c
          in xs

Tail recursion is anothing common approach for this kind of problems.

fbm :: Int -> Int -> Int -> (Int, Int, Int, Int)
-- a[0] = m
-- a[1] = n
-- a[2] = m + n
-- a[3] = m + 2 * n
fbm m n 3 = (m+2*n, m+n, n, m)
fbm m n x = case (x `div` 2) `mod` 2 of
                 1 -> (a+b, a, b, c)
                 0 -> (a-d, a, b, c)
  where (a,b,c,d) = fbm m n (x-1)

Last but not least, here is a mathematical solution.

a[0] = m
a[1] = n
a[2] = m + n
a[3] = m + 2n
a[4] = 2n
a[5] = n
a[6] = 3n
a[7] = 4n
a[8] = 2n

fbs m n = [m, n, m+n, m+2*n] ++ cycle [2*n, n, 3*n, 4*n]

Answer 2

I'd like to propose two solutions, which also based on the concept of memoisation introduced here by dbaupp. Unlike the existing answer, following solutions compute new elements of the list using indices instead of values of previous elements.

The first idea is following

fbs :: Int -> Int -> [Int]
fbs m n = m : n : map (fbMake m n) [2 ..]

fbMake :: Int -> Int -> Int -> Int
fbMake m n = f
  where f i | (i `div` 2) `mod` 2 == 1 = (xs !! (i - 1)) + (xs !! (i - 2))
            | otherwise                = (xs !! (i - 1)) - (xs !! (i - 4))
        xs = fbs m n

This solution builds elements of the fbs m n list from its memoised predecessors. Unfortunately, due to the fact that indexing of lists is O(n) it performs rather poorly.

What's better when it comes to indexing than lists? Arrays come into play. Here's the second solution.

import Data.Array

fbs :: Int -> Int -> Int -> [Int]
fbs m n k = m : n : map (fbm m n k) [2 .. k]

fbsArr :: Int -> Int -> Int -> Array Int Int
fbsArr m n k = listArray (0, k) (fbs m n k)

fbm :: Int -> Int -> Int -> Int -> Int
fbm m n k i | (i `div` 2) `mod` 2 == 1 = (xs ! (i - 1)) + (xs ! (i - 2))
            | otherwise                = (xs ! (i - 1)) - (xs ! (i - 4))
  where xs = fbsArr m n k

It's nearly the same as the first one, but this time the results are memoised in an array and indexing its elements is significantly faster. According to my tests it generates answers for (m, n, k) = (2, 3, 1000) over 10 times faster than the list-based approach. The answer in this case is fbsArr m n k ! k.