Make a list of Fibonacci numbers less than 1000, whose index is in the form 3m+1. Verify that all these numbers are odd

I've been working on this for far too long with unsatisfactory results. And after losing all my hours of work around 4am thanks to a glitch in the program itself, I'm at my wit's end.

It was suggested to use tables and intersection, but I simply cannot figure out for the life of me how to do it like that. I've constructed a matrix have been trying to use position to pull the Fibonacci values from the relevant indices.

Mathematica is completely new to me, and the CS prerequisite course before this one was woefully inadequate for any kind of useful coding. And unfortunately, our professor is 'not a programmer', so the help is not always as helpful as would be helpful.

This is what I have so far:

n = 5;
a = 1000;
(*fib=For[i=0;f=0;f1=0;f2=1;m=0,i\[LessEqual]n;f<a,i++;m++,f=f1+f2;f1=\
f2;f2=f;in=3m+1;Print[{i,in,f1}]]*)
fibindex = Table[x++, {x, i}]
fibtb = Table[Fibonacci[f], {f, i}]
Print[i]
indfrm = Table[3 b + 1, {b, i}]
fibmat = {Table[x++, {x, i}], Table[Fibonacci[f], {f, i}]} //
MatrixForm
MatrixForm[{fibindex, fibtb}]
Intersection[indfrm, fibindex]
Position[fibindex, 3 b + 1]


Any and all help will be greatly appreciated. Thanks.

• Obtaining the table is a matter of taking every third Fibonacci number, starting at the first. Finding the last value in the iteration can be done "the hard way" (keep iterating until you exceed 1000), or can be found in advance with a bit of math. Here is one such approach. In[16]:= imax = 2 + Floor[Log[GoldenRatio, 1000]] Out[16]= 16 In[18]:= Table[Fibonacci[j], {j, 1, imax, 3}] Out[18]= {1, 3, 13, 55, 233, 987} – Daniel Lichtblau Oct 13 at 14:34
• Not exactly an answer to the question, but note that Mathematica can do: Solve[Mod[Fibonacci[n], 2] == 1, n, Integers] – user64074 Oct 15 at 7:06
• You can verify that all of those numbers are odd without even constructing a list: Resolve[ForAll[m, 0 <= m < ArgMin[{n, 0 <= n <= 1000 && Fibonacci[3 n + 1] >= 1000}, n, Integers], Mod[Fibonacci[3 m + 1], 2] == 1], Integers]- the only less obvious parts here are constraining maximum values of n and m. – kirma Nov 2 at 13:34

Below are a few approaches. They are grouped into two steps: First, generate the list of all numbers $$Fib(3m+1)$$ below 1000. Second, check that they are all odd.

Generation

m = 0;
fib = Reap[While[Sow@Fibonacci[3 m + 1] < 1000, ++m]][[2, 1, ;; -2]]
(* {1, 3, 13, 55, 233, 987} *)

fib = Extract[{;; ;; 3}]@ (* get the terms with index 3m+1 *)
NestWhileList[Round[# GoldenRatio] &, 1, LessThan@1000, 1, ∞, -1];

fib = Select[LessThan@1000]@Table[Fibonacci[3 m + 1], {m, 20}]]
(* same output *)

fib = Select[#<1000&]@Table[Fibonacci[i], {i, 1, 20, 3}]
(* same output *)

fib = Select[Fibonacci /@ Range[1, 20, 3], # < 1000&]
(* same output *)

fib = ResourceFunction["TableWhile"][
Fibonacci[n], {n, 1, Infinity, 3}, LessThan@1000
];
(* same output *)


Notes:

The second example uses the fact that

$$Fib(n+1)=\lfloor \phi\cdot Fib(n) \rceil$$

where $$\phi$$ is the golden ratio and $$\lfloor\bullet\rceil$$ rounds to the nearest integer.

The upper limit in the 3rd, 4th and 5th example can also be found programmatically using (see @BobHanlon's answer)

(* max n such that Fibonacci[n] < 1000 *)
Floor@n /. First@Quiet@NSolve[Fibonacci[n] == 1000, n]
(* max m such that Fibonacci[3m+1] < 1000 *)
Floor@m /. First@Quiet@NSolve[Fibonacci[3m+1] == 1000, m]


Note also the use of ResourceFunction["TableWhile"] in the last example, which will only work in 11.3 and higher

Checking

All of these can be used to verify that all the numbers in fib are indeed odd:

AllTrue[OddQ]@fib
(* True *)

And @@ OddQ /@ fib
(* True *)

And @@ OddQ@fib
(* True *)

MatchQ[{___?OddQ}]@fib
(* same output *)

• @yarchik The arbitrary limit for the table in examples 2-4 is indeed a good point, I've added a note on how to get it programmatically. – Lukas Lang Oct 15 at 7:55
• @yarchik Regarding the procedural approaches: Believe me, I'm the last person that will recommend a procedural solution in MMA. But the problem is that there is no good functional solution for this case - just look at the other answers, the only truly general and functional solution is @kglr's NestWhileList solution, but that one is extremely hard to read, especially for a beginner. (continued...) – Lukas Lang Oct 15 at 7:58
• (...continued) In my opinion, the ideal solution is to use TableWhile, which unfortunately is not shipped with MMA. But it fits nicely into the style of MMA, is easily readable and easy to use for anyone in 11.3+. Also, while backward compatibility is something to always keep in mind (there is a reason why that example is the last one on the list), I see no reason not to show simpler solutions using newer features. – Lukas Lang Oct 15 at 8:00
• See my solution. I claim that it is a truly functional one. – yarchik Oct 15 at 8:41
• Thanks for modifications. Now it is a more self-contained solution. – yarchik Oct 15 at 8:51

NestWhileList:

NestWhileList[{#[[1]] + 3, Fibonacci[#[[1]]]} &, {1, 1}, #[[2]] < 1000 &][[2 ;; -2, -1]]


{1, 3, 13, 55, 233, 987}

And @@ OddQ@%


True

Do + Break:

lst = {};
Do[If[(x = Fibonacci[i]) <= 1000, AppendTo[lst, x], Break[]], {i, 1, 200, 3}];
lst


{1, 3, 13, 55, 233, 987}

While

lst = {};
i = 0;
While[(x = Fibonacci[1 + 3 i++]) <= 1000, AppendTo[lst, x]];
lst


{1, 3, 13, 55, 233, 987}

• (-) These are all procedural, not functional solutions. Not good for a beginner who wants to learn the functional style of MA. Moreover, the do-and-break solution requires an empirical upper limit. – yarchik Oct 15 at 7:14
• The upper limit in the Do example mentioned by @yarchik can be trivially replaced by ∞ - it will then only stop when Break[] or similar is encountered (see Details section of the documentation of Do) – Lukas Lang Oct 15 at 8:04
• @yarchik You are of course free to downvote procedural solutions, but I don't see the point in doing so when there is no functional alternative available. (all the other solutions are either also procedural or use some special property of the fibonacci sequence and are therefore not easily generalizable to other sequences) - Also, what is not functional about the NestWhileList solution? – Lukas Lang Oct 15 at 8:09
mmax = m /. NSolve[Fibonacci[3 m + 1] == 1000, m][[1]] // Floor // Quiet

(* 5 *)

fib = Fibonacci[3 # + 1] & /@ Range[0, mmax]

(* {1, 3, 13, 55, 233, 987} *)

And @@ (OddQ /@ fib)

(* True *)


One way:

Fibonacci[Range[1, InverseFunction[Fibonacci][1000.], 3]]
(*  {1, 3, 13, 55, 233, 987}  *)


Based on the analytic formula for the Fibonacci numbers:

GoldenRatio^Range[1, Log[GoldenRatio, 1000 Sqrt[5]], 3]/Sqrt[5] // Round
(*  {1, 3, 13, 55, 233, 987}  *)


Or for speed:

N[GoldenRatio]^Range[1, Log[N@GoldenRatio, 1000 Sqrt[5.]], 3]/Sqrt[5.] // Round


Slightly faster, using the built-in Fibonacci[]:

Fibonacci@ Range[1, Log[N@GoldenRatio, 1000 Sqrt[5.]], 3]


I demonstrate below a paradigmatic functional solution

list = Fibonacci /@ NestWhileList[(# + 3) &, 1, Fibonacci[# + 1] <= 10^3 &]
(* {1, 3, 13, 55, 233, 987} *)


Notice a much simpler construction compared to other solutions.

The next line establishes that all numbers are odd as per mathematical induction.

FindLinearRecurrence[list]
(* {4, 1} *)


This is equivalent to

$$F_n=4F_{n-1}+F_{n-2}$$

If the first number is odd, which it is, so all others are odd. This also works for negative numbers.

By the way, the Fibonacci numbers are also defined for negative indices and mathematical induction is the only way to verify that all of them are odd.

• It should be noted that you're essentially calling the function (Fibonacci here) twice for each index - while this is clearly not an issue here, I'd generally try to avoid doing the same thing multiple times. The problem is of course that you end up with @kglr's solution if you try to avoid that, which is arguably much less readable. (you could also add a memoizing wrapper function, but that seems a bit hacky) - +1 anyway – Lukas Lang Oct 15 at 8:46
• @LukasLang Thanks for upvote. I accept your criticism on the point of double calling. – yarchik Oct 15 at 8:50

This may be more in the spirit of your previous class.

(* First, make an empty list of Fibonacci numbers of
the intended form of index *)
Fibonacci3mPlus1s = {};
(* Accumulate Fibonacci numbers of index 1, 3+1, 6+1,
... until the associated Fibonacci number meets or
exceeds 1000 *)
For[index = 1, Fibonacci[index] < 1000, index += 3,
AppendTo[Fibonacci3mPlus1s, Fibonacci[index]];
]
(* Now check that there are no even numbers in the
accumulated list. *)
Length[Select[Fibonacci3mPlus1s, EvenQ]] == 0
(* Output: True *)




(* Optional: Inspect the list *)
Fibonacci3mPlus1s
(* Output: {1, 3, 13, 55, 233, 987} *)


So if your professor is not a programmer but a mathematician, he may appreciate that you give him also the result without any line of code. You can easily prove that all Fibonacci numbers whose index is a multiple of three are even and all the others (including F_{3m+1}) are odd. By induction, odd and odd gives the next as even, then odd and even gives the next as odd, then even and odd gives the next as odd, but odd and odd is cycling with the same conclusion than initially, with a periodicity of three in the index. Now F_1 = F_2 = 1 are odd, therefore F_{3m+1} and F_{3m+2} are odd and F_{3m} are even. Isn' t it? But Mathematica will help you to solve many other problems that mathematical induction (https://en.wikipedia.org/wiki/Mathematical_induction) can not. Being sure now, you can still check with this Mathematica code:

And@@OddQ/@(Fibonacci[3#+1]&/@Range[0,5])


It will display True, even if you change 5 to 50 or 500...