Improve performance for finding Fibonacci number which have divisibility property

In this post, the OP requires finding a Fibonacci number having some divisibility property with Mathematica and Maxima. I tired tried that Mathematica code on Mathematica 9.0 and it’s still slow (about 100 seconds). Can we improve the Mathematica implemention?

fibRatio[a_, b_] := FullSimplify[Sum[Fibonacci[n + i], {i, 0, a}]/Fibonacci[n + b]]

Select[
Flatten[Table[{a, b, fibRatio[a, b]}, {a, 1, 10}, {b, 1, a}], 1],
IntegerQ[#[[3]]] &
]

=================

Change := to =. And why there is still n, it will never be integer without specifying n.
– swish
May 5 ’13 at 17:22

1

Yes it can be an integer: a=b=2 and a=9,b=6 both give integers.
– bill s
May 5 ’13 at 18:01

It’s actually quite interesting. Look at the a=b=2 case to see how it works. The fibRatio function gives (Fibonacci[n] + Fibonacci[1 + n] + Fibonacci[2 + n])/Fibonacci[2 + n] which it then simplifies using the fact that Fibonacci[n] + Fibonacci[1 + n]=Fibonacci[2 + n] and hence to the constant 2. It holds for any n, I guess, unless it is automatically assuming integer-values for the n.
– bill s
May 5 ’13 at 19:45

I don’t understand what you are going to do without telling us the value of n. But using the symbolic nature of Mathematica, you can solve the general expression explicitly by using Sum[Fibonacci[n + i], {i, 0, a}], and that will speed up a lot.
– luyuwuli
May 6 ’13 at 1:50

=================

1

=================

We have, for all integer a and n

Sum[Fibonacci[n + i], {i, 0, a}] ==
Fibonacci[n + a + 2] – Fibonacci[n + 1]

(-> True)

This can be seen by evaluating

Table[
Sum[Fibonacci[n + i], {i, 0, a}] ==
Fibonacci[n + a + 2] – Fibonacci[n + 1],
{a, 1, 10},
{n, 1, 10}
]

which gives a bunch of True’s.

You can then simply do

n = 1000;
fibRatio[a_, b_] := (Fibonacci[n + a + 2] – Fibonacci[n + 1])/
Fibonacci[n + b]

Select[Flatten[Table[{a, b, fibRatio[a, b]}, {a, 1, 10}, {b, 1, a}],
1], IntegerQ[#[[3]]] &] // Timing

-> {0.004000, {{2, 2, 2}, {5, 4, 4}, {9, 6, 11}}}

I was going to say more about this, but I have to go, but maybe take a look at the following example, which does not do exactly what you want, but generates values and selects them in one swoop, rather than first generating values and then selecting some of them.

Flatten[
Array[
Function[
Function[
xxxx,

If[
IntegerQ[xxxx],
{#, #2, xxxx},
Unevaluated[Sequence[]]
]
]@
fibRatio[#, #2]
],
{10, 10},
{1, 1}
]
, 1
]

-> {{1, 2, 1}, {2, 2, 2}, {5, 4, 4}, {9, 6, 11}}

This could be improved by using nested calls of Array. Oh well 🙂

Thank you. But, Which version are you using? I used Mathematica9.0, in my PC, your code return an empty list.
– chyaong
May 6 ’13 at 15:11

1

@chyanog that’s because n is undefined. If you change {a, 1, 10} to {a, 1, n = 10}, you get a sensible output.
– rcollyer
May 6 ’13 at 18:48