5
$\begingroup$

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.

Improve this question
$\endgroup$
3
  • 3
    $\begingroup$ 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} $\endgroup$
    – Daniel Lichtblau
    Oct 13, 2019 at 14:34
  • $\begingroup$ Not exactly an answer to the question, but note that Mathematica can do: Solve[Mod[Fibonacci[n], 2] == 1, n, Integers] $\endgroup$
    – user64074
    Oct 15, 2019 at 7:06
  • $\begingroup$ 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. $\endgroup$
    – kirma
    Nov 2, 2019 at 13:34

7 Answers 7

Reset to default
10
$\begingroup$

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 *)
 Prepend[1]@ (* add an additional 1 for Fibonacci[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, LessThan@1000, 3}
];
(* 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 *)
Improve this answer
$\endgroup$
5
  • $\begingroup$ @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. $\endgroup$
    – Lukas Lang
    Oct 15, 2019 at 7:55
  • $\begingroup$ @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...) $\endgroup$
    – Lukas Lang
    Oct 15, 2019 at 7:58
  • $\begingroup$ (...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. $\endgroup$
    – Lukas Lang
    Oct 15, 2019 at 8:00
  • $\begingroup$ See my solution. I claim that it is a truly functional one. $\endgroup$
    – yarchik
    Oct 15, 2019 at 8:41
  • $\begingroup$ Thanks for modifications. Now it is a more self-contained solution. $\endgroup$
    – yarchik
    Oct 15, 2019 at 8:51
6
$\begingroup$

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}

Improve this answer
$\endgroup$
3
  • $\begingroup$ (-) 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. $\endgroup$
    – yarchik
    Oct 15, 2019 at 7:14
  • 1
    $\begingroup$ 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) $\endgroup$
    – Lukas Lang
    Oct 15, 2019 at 8:04
  • 1
    $\begingroup$ @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? $\endgroup$
    – Lukas Lang
    Oct 15, 2019 at 8:09
4
$\begingroup$ 
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 *)
Improve this answer
$\endgroup$
3
$\begingroup$

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]
Improve this answer
$\endgroup$
3
$\begingroup$

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.

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ 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 $\endgroup$
    – Lukas Lang
    Oct 15, 2019 at 8:46
  • $\begingroup$ @LukasLang Thanks for upvote. I accept your criticism on the point of double calling. $\endgroup$
    – yarchik
    Oct 15, 2019 at 8:50
2
$\begingroup$

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...

Improve this answer
$\endgroup$
1
$\begingroup$

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} *)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.