10
$\begingroup$

How can I make a Tribonacci sequence that is in listing form? it suppose to look like the Fibonacci sequence but I couldn't get the same result with Tribonacci.enter image description here

Array[Fibonacci, 9]

{1, 1, 2, 3, 5, 8, 13, 21, 34}

Array[Tribonacci, 9]

{Tribonacci[1], Tribonacci[2], Tribonacci[3], Tribonacci[4], 
 Tribonacci[5], Tribonacci[6], Tribonacci[7], Tribonacci[8], Tribonacci[9]}
|improve this question
$\endgroup$
15
$\begingroup$

Is Tribonacci defined?

First you should notice that Tribonacci is not already defined by Mathematica. Compare the defined Fibonacci

?Fibonacci

Mathematica graphics

with 

?Tribonacci

Mathematica graphics

You could have guessed by the color of the function in the front-end display, black for defined and blue for undefined.

Fibonacci n-Step Number

Now we can define the even more general Fibonacci n-Step Number. We will use memoization 

ClearAll[FnStepN];
FnStepN[0, n_] = 0; FnStepN[1, n_] = 1; FnStepN[2, n_] = 1;

FnStepN[k_Integer, n_Integer] := 
 FnStepN[k, n] = Sum[FnStepN[k - i, n], {i, 1, Min[k, n]}]


TableForm[
 Table[FnStepN[k, n], {n, 10}, {k, 10}]
 , TableHeadings -> Automatic
 ]

Mathematica graphics

EDIT

After the answer by @Mr.Wizard here is an alternative implementation of Fibonacci n-Step Number but giving the whole list

FibStepN[k_Integer, n_Integer] := Take[
  LinearRecurrence[
   Table[1, {n}]
   , PadLeft[{1, 1}, n]
   , k + n - 2
   ]
  , -k]

Or

FibStepN[k_Integer, n_Integer] := 
 Nest[Append[#, Total[Take[#, -Min[n, Length[#]]]]] &, {1, 1}, k - 2]

Tribonacci

Now Tribonacci is just a special case of FnStepN

Tribonacci[k_] = FnStepN[k, 3]

Array[Tribonacci, 11]

{1, 1, 2, 4, 7, 13, 24, 44, 81, 149, 274}

For performance look at this other similar answer.

|improve this answer
$\endgroup$
  • 1
    $\begingroup$ What should I change in order to have this kind of result for lucas n-step sequence? aside from changing FnStepN into LnStepN. $\endgroup$ – Charles Oct 13 '15 at 13:09
  • $\begingroup$ @Charles I have provided an answer to your question here $\endgroup$ – rhermans Oct 13 '15 at 16:11
12
$\begingroup$

LinearRecurrence is useful here:

LinearRecurrence[{1, 1, 1}, {1, 1, 2}, 9]

{1, 1, 2, 4, 7, 13, 24, 44, 81}

Related:

|improve this answer
$\endgroup$
  • $\begingroup$ Your answer is shifted {1, 1, 2, 4, 7, 13, 24, 44, 81, 149} -> {0, 1, 1, 2, 4, 7, 13, 24, 44, 81} $\endgroup$ – rhermans Oct 10 '15 at 11:01
  • 1
    $\begingroup$ @rhermans I did not see that as a sufficiently difficult problem to address, but one can use e.g. Rest or LinearRecurrence[{1, 1, 1}, {0, 1, 1}, {2, 10}] as he sees fit. Oh, or use LinearRecurrence[{1, 1, 1}, {1, 1, 2}, 9] which is probably what you were getting at. :-o I'll edit that in. $\endgroup$ – Mr.Wizard♦ Oct 10 '15 at 16:55
  • 1
    $\begingroup$ This is the right way, IMO...+1 $\endgroup$ – ciao Oct 10 '15 at 22:46
10
$\begingroup$

As noted by the Wizard, LinearRecurrence[] is an excellent way to handle integer sequences based on linear difference equations. Had that mechanism not been available, one can exploit the relationship between linear recurrences and powers of the Frobenius companion matrix of the recurrence's characteristic polynomial:

SetAttributes[Tribonacci, Listable];
Tribonacci[0] = 0;
Tribonacci[1] = Tribonacci[2] = 1;
Tribonacci[k_Integer?Positive] :=
           MatrixPower[{{1, 1, 1}, {1, 0, 0}, {0, 1, 0}}, k - 2, {1, 1, 0}][[1]]

where I used the "action" form of MatrixPower[].

Some insight into how this works can be seen by looking at the associated matrix in two different ways. Let

$$\mathbf F=\begin{pmatrix}1&\cdots&&1\\1&&&\\&\ddots&&\\&&1&\end{pmatrix}=\mathbf S+\mathbf e_1\mathbf e^\top$$

where $\mathbf S$ is the "shift matrix" (the matrix that transforms $\begin{pmatrix}c_1&\cdots&c_n\end{pmatrix}^\top$ to $\begin{pmatrix}0&c_1&\cdots&c_{k-1}\end{pmatrix}^\top$, $\mathbf e$ is ConstantArray[1, k] in Mathematica notation, and $\mathbf e_1$ is UnitVector[k, 1] in Mathematica notation. This particular decomposition shows how the linear recurrence proceeds: the shift matrix moves the contents of the column vector containing the initial conditions downward, and the correction term sets up the appropriate linear combination of the vector's components.

The other way to look at $\mathbf F$ is to note that it is, as I mentioned earlier, the Frobenius companion matrix of $x^k-\sum_{j=1}^{k-1} x^j$, which is the characteristic polynomial of the linear recurrence $F_n=\sum_{j=1}^k F_{n-j}$. $\mathbf F$ thus has the eigendecomposition

$$\mathbf F=\mathbf V\begin{pmatrix}x_1&&\\&\ddots&\\&&x_k\end{pmatrix}\mathbf V^{-1}$$

and the $x_j$ are the $k$ roots of the characteristic polynomial. $\mathbf F^n$ thus has the eigendecomposition

$$\mathbf F^n=\mathbf V\begin{pmatrix}x_1^n&&\\&\ddots&\\&&x_k^n\end{pmatrix}\mathbf V^{-1}$$

and the entire business is revealed to be equivalent to taking appropriate linear combinations of the $x_j^n$.

Extra credit

The machinery behind DifferenceRoot[] can of course be used to implement the general $k$-nacci number. Witness the following:

knacci[k_Integer?Positive] := knacci[k] = 
       DifferenceRoot[Function @@
                      {{\[FormalY], \[FormalN]}, 
                       Prepend[Thread[(\[FormalY] /@ {1, 2}) == 1] ~Join~
                               Thread[(\[FormalY] /@ Range[3 - k, 0]) == 0],
                               \[FormalY][\[FormalN]] ==
                               Sum[\[FormalY][\[FormalN] - K], {K, 1, k}]]}]

after which, one can do Tribonacci = knacci[3].

Still another possibility is to use SeriesCoefficient[] on the generating function:

knacci[k_Integer?Positive, n_Integer?NonNegative] := 
       SeriesCoefficient[(\[FormalX] (1 - \[FormalX]))/
                         (1 - 2 \[FormalX] + \[FormalX]^(k + 1)), {\[FormalX], 0, n}]

Carrying the generating function idea further along, one could consider using Cauchy's differentiation formula with an appropriate anticlockwise contour to evaluate $k$-nacci numbers. Here is one such routine based on this idea:

SetAttributes[knacci, Listable]
knacci[k_Integer?Positive, n_?NumericQ] := 
       Re[NIntegrate[(1 - z)/((1 - 2 z + z^(k + 1)) z^n),
                     {z, -1/2, -I/2, 1/2, I/2, -1/2}]/(2 π I)]
|improve this answer
$\endgroup$
  • 1
    $\begingroup$ FWIW I did reference this in the last link in my answer, but +1 of course. $\endgroup$ – Mr.Wizard♦ Oct 10 '15 at 10:51
  • 1
    $\begingroup$ I saw that. :) The missing piece was to use the "action" form instead of explicitly forming the power before multiplying. The version using Nest[] on an appropriate starting vector does sidestep the problem. $\endgroup$ – J. M. is away♦ Oct 10 '15 at 10:53
  • 2
    $\begingroup$ The first idea comes to my mind is MatrixPower when I see the definion of Enrique Pérez Herrero. Please see here $\endgroup$ – xyz Oct 10 '15 at 14:08
  • 2
    $\begingroup$ J.M, could you add the theroy about why you using the MatrixPower ? I think it is necessary for others understand your implementation easily:) $\endgroup$ – xyz Oct 10 '15 at 14:13
  • $\begingroup$ @Shutao, maybe later; that's a rather long discussion... $\endgroup$ – J. M. is away♦ Oct 10 '15 at 14:15
7
$\begingroup$

If -- like with Fibonacci -- you want Tribonacci defined more generally than just for integer arguments, use RSolve.

Clear[Tribonacci];
Tribonacci[n_] = Tribonacci[n] /. RSolve[{Tribonacci[0] == 0,
        Tribonacci[1] == 1,
        Tribonacci[2] == 1,
        Tribonacci[n] == 
         Tribonacci[n - 1] + Tribonacci[n - 2] + Tribonacci[n - 3]}, 
       Tribonacci[n], n][[1]] // ToRadicals // Simplify;
Tribonacci[n_Integer] :=
  Tribonacci[N[n]] // Chop // Round;

The last definition for integer arguments is added to speed up the calculations. To get a simple result for integers would generally require use of FullSimplify of a very complicated expression and would be quite slow. The numerical approximation is much faster but requires Chop to remove imaginary artifacts caused by use of machine precision and Round to give the exact solution desired.

Tribonacci /@ Range[0, 10]

(*  {0, 1, 1, 2, 4, 7, 13, 24, 44, 81, 149}  *)

Show[
 Plot[Tribonacci[n], {n, -10, 10}],
 DiscretePlot[Tribonacci[n], {n, -10, 8},
  PlotStyle -> Red],
 PlotRange -> All]

enter image description here

|improve this answer
$\endgroup$
  • 2
    $\begingroup$ As it turns out, you could also use FunctionExpand[DifferenceRoot[(* stuff *)][n]] to derive explicit expressions for $k$-nacci numbers. $\endgroup$ – J. M. is away♦ Oct 10 '15 at 16:50
7
$\begingroup$ 
Tribonacci[0] := 0;
Tribonacci[1] := 1;
Tribonacci[2] := 1;
Tribonacci[3] := 2;
Tribonacci[n_] := 
Tribonacci[n] = 
Tribonacci[n - 1] + Tribonacci[n - 2] + Tribonacci[n - 3];
Array[Tribonacci, 9]
(* {1, 1, 2, 4, 7, 13, 24, 44, 81} *)

An alternate expression can be found in https://oeis.org/A000073:

CoefficientList[Series[x^2/(1 - x - x^2 - x^3), {x, 0, 50}], x]

Also you can find more information about: Tribonacci[n] - Fibonacci[n], in: https://oeis.org/A000100

Even more...

a = (19 + 3*Sqrt[33])^(1/3);
b = (19 - 3*Sqrt[33])^(1/3);
Trib[n_] := Round[3*((a + b + 1)/3)^(n + 1)/(a^2 + b^2 + 4)]
Table[Trib[n] - Tribonacci[n], {n, 1, 20}]
(* {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} *)
|improve this answer
$\endgroup$
6
$\begingroup$

Using SequenceFold

tribonacci[n_] := SequenceFold[Plus, {1, 1, 2}, ConstantArray[0, n - 3]]
tribonacci[1] = tribonacci[2] = 1;

Array[tribonacci, 9]

$\ ${1, 1, 2, 4, 7, 13, 24, 44, 81}

or SequenceFoldList

tribonacciList[n_] := SequenceFoldList[Plus, {1, 1, 2}, ConstantArray[0, n - 3]]
tribonacciList[1] = {1};
tribonacciList[2] = {1, 1};

tribonacciList[9]

$\ ${1, 1, 2, 4, 7, 13, 24, 44, 81}

Benchmark table of the AbsoluteTimings for the calculation of a list of the first 9 and 5000 Tribonacci numers:

|improve this answer
$\endgroup$
  • 1
    $\begingroup$ Would you add benchmarks for these? I am curious to know how these functions (SequenceFold family) perform and I do not have v10.2. $\endgroup$ – Mr.Wizard♦ Oct 10 '15 at 17:56
  • 1
    $\begingroup$ @Mr.Wizard I'll put that on my list for tomorrow. But I can already say that my performance expectations are relatively low, as these functions are implemented as high level functions using Fold and FoldList, respectively. $\endgroup$ – Karsten 7. Oct 10 '15 at 19:15
  • 1
    $\begingroup$ @Mr.Wizard compared to the other methods, using SequenceFoldList actually performs really good. $\endgroup$ – Karsten 7. Oct 11 '15 at 22:16
5
$\begingroup$

Additional theory explanation for J.M.'s answer

The definition of Tribonacci[] can be written as below:

$$a_{n+3}=a_n+a_{n+1}+a_{n+2}$$

then

we could construct the following recursive matrix formula

$$ \begin{pmatrix} a_{n+3}\\ a_{n+2}\\ a_{n+1} \end{pmatrix} = \begin{pmatrix} 1 && 1 && 1\\ 1 && 0 && 0\\ 0 && 1 && 0 \end{pmatrix} \begin{pmatrix} a_{n+2}\\ a_{n+1}\\ a_{n} \end{pmatrix} =A^2\begin{pmatrix} a_{n+1}\\ a_{n}\\ a_{n-1} \end{pmatrix}=\cdots= A^{n+1}\begin{pmatrix} a_{2}\\ a_{1}\\ a_{0} \end{pmatrix} $$

where,

$A=\begin{pmatrix} 1 && 1 && 1\\ 1 && 0 && 0\\ 0 && 1 && 0 \end{pmatrix} $

|improve this answer
$\endgroup$
  • 2
    $\begingroup$ Your companion matrix is backwards; the subdiagonal goes from left to right. $\endgroup$ – J. M. is away♦ Oct 10 '15 at 14:45
  • $\begingroup$ @J.M. OK, I made a mistake. THX:) $\endgroup$ – xyz Oct 10 '15 at 14:48
4
$\begingroup$

Tail recursive implementation

tribo[n_, a_, b_, c_] := tribo[n - 1, b, c, a + b + c]
tribo[0, a_, b_, c_] := a
tribo[n_] := tribo[n, 0, 1, 1]

Array[tribo, 9] // AbsoluteTiming

$\ ${0.0000928937, {1, 1, 2, 4, 7, 13, 24, 44, 81}}

Block[{$IterationLimit = Infinity},
 tribo~Array~5000; // AbsoluteTiming // First]

$\ $25.2784

And for a faster generation of Tribonacci lists

triboList[n_, a_, b_, c_] := triboList[n - 1, Sow[b], c, a + b + c]
triboList[1, a_, b_, c_] := Sow[b]
triboList[n_] := Reap[triboList[n, 0, 1, 1]][[2, 1]]

triboList[9] // AbsoluteTiming

$\ ${0.0000497884, {1, 1, 2, 4, 7, 13, 24, 44, 81}}

Block[{$IterationLimit = Infinity},
 triboList[5000]; // AbsoluteTiming // First]

$\ $0.0129951

|improve this answer
$\endgroup$
0
$\begingroup$

How about something like:

ContinuedFraction[Root[#^3-#^2-#-1]&,1],100]

or Convergents[N[Convergents[N[t]]]]

From Mathworld:

The ratio of adjacent terms tends to the positive real root (x^3-x^2-x-1)_1, namely 1.83929... (OEIS A058265), sometimes known as the tribonacci constant.

|improve this answer
$\endgroup$
  • $\begingroup$ There is a typographical error here; would you try to fix it please? I'd like to see this working. $\endgroup$ – Mr.Wizard♦ Oct 14 '15 at 22:06
  • $\begingroup$ I'm sure there's more than just a typographical error, but try: ContinuedFraction[N[Root[#^3-#^2-#-1]&,1]],100] $\endgroup$ – pdmclean Oct 15 '15 at 2:18
  • 1
    $\begingroup$ Unfortunately, the approach here is flawed; the number whose simple CF expansion contains the tribonacci numbers is approximately 1.6914979485021664824009037684992342805376592458272, which is quite far from the value of Root[#^3 - #^2 - # - 1 &, 1] (1.8392867552141611325518525646532866004241787460976). $\endgroup$ – J. M. is away♦ Oct 15 '15 at 18:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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