29

I'm really surprised if this question isn't a duplicate, but since I failed to find one that asked about the Fibonacci sequence rather than someone using it as an example, I'll answer. The most natural approach, besides using the built-in Fibonacci function, recursion: f[0] = 0; f[1] = 1; f[n_] := f[n] = f[n - 1] + f[n - 2] (* note memoization *) Array[f,...


29

I can't take much credit for this answer--I hadn't even got version 10.2 installed until J. M. commented to me that these functions could be written efficiently in terms of the Hamming weight function. But, it is understandable that he doesn't want to write an answer using a smartphone. The definition of the built-in ThueMorse is: ThueMorse[n_Integer] := ...


23

The sum of consecutive numbers from $a$ to $b$ is $$\frac{(a+b)(b-a+1)}{2}$$ hence simply f[n_] := {a, b} /. Solve[(a + b) (b - a + 1)/2 == n && 0 < a < n && 0 < b < n, {a, b}, Integers] f[45] // AbsoluteTiming {0.019466, {{1, 9}, {5, 10}, {7, 11}, {14, 16}, {22, 23}}} It is straightforward and rather fast. As a test ...


18

My own take on this: Clear[f] f[0] = 0; f[n_] := f[n] = If[Or[MemberQ[Last /@ Most[DownValues[f]], f[n - 1] - n], f[n - 1] < n], f[n - 1] + n, f[n - 1] - n] f /@ Range[0, 11] (* {0, 1, 3, 6, 2, 7, 13, 20, 12, 21, 11, 22} *) We can draw the figure using With[{list = Table[f[n], {n, 0, 30}]}, Show[Graphics@*Circle @@@ Partition[Flatten[{ ...


17

Just the visualization part using ParametricPlot: recamanSequencePlot1 = ParametricPlot[ Evaluate[Map[RotationTransform[Pi/4] @ {Mean @ # + (#[[2]] - #[[1]])/2 Cos[t], (#[[2]] - #[[1]])/2 Sin[t]} &, Partition[#, 2, 1]]], {t, 0, -Pi}, AspectRatio -> Automatic, Axes -> False, ImageSize -> Large] &; Using ...


17

This can be computed almost instantaneously due to one curious property of the Fibonacci numbers: Their sequence is periodic modulo any modulus $m$. These periods are known as Pisano periods $\pi(m)$. For 10 the period is 60. Therefore we have FibLastDigit[n_] := Mod[Fibonacci[Mod[n, 60]], 10] This is presumably faster than any other method. Even faster ...


16

IF you can assume 1) they are integers, 2) they are ascending, and 3) no repeats, THEN your last idea should work Last[list]-First[list]==Length[list]-1 Or you could Union[Differences[list]]=={1} Without assumptions (2) and (3): Union[Differences[Sort[list]]]=={1}


16

fibSequences[n_?EvenQ] := Nest[Accumulate[Join[{1, 0}, #]] &, {}, n/2] fibSequences[n_?OddQ] := Most@Nest[Accumulate[Join[{1, 0}, #]] &, {}, (n + 1)/2] fibSequences[10] {1, 1, 2, 3, 5, 8, 13, 21, 34, 55} fibSequences[9] {1, 1, 2, 3, 5, 8, 13, 21, 34}


16

NestList[] is very handy for situations like this: tr[Polygon[p_]] := Polygon[Composition[TranslationTransform[First[p]], AffineTransform[{{0, -1}, {1, 0}}/GoldenRatio], TranslationTransform[-Last[p]]] @ p] g1 = Graphics[{EdgeForm[Black], MapIndexed[{ColorData[61] @@ #2, #1} &, NestList[tr, Polygon[{{GoldenRatio, 0}, {GoldenRatio, 1}, {0, 1}, {...


15

We can substantially speed up the calculation for large primes by making some elementary observations about the Fibonacci series. There are two motivating ideas behind them: Almost all the properties of the Fibonacci series rely only on the field axioms, so that the theory of Fibonacci series (and linear recurrences in general) holds practically without ...


15

This is probably defeating your professor's unspoken desire, but no one explicitly said you required a recursion. It may or may not entertain you to know Binet's formula. Without checking, I would guess that this approach is similar to how the built in function computes Fibonacci numbers. It is clearly computationally cheaper than any sort of recursion or ...


15

Is Tribonacci defined? First you should notice that Tribonacci is not already defined by Mathematica. Compare the defined Fibonacci ?Fibonacci with ?Tribonacci 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 ...


13

A short one: consecutiveQ = Most[#] == Rest[#] - 1 &


13

A combination of IntegerPartitions, RandomChoiceand RandomSample: n = 30; RandomSample @ RandomChoice @ IntegerPartitions[0, {n}, {-1, 0, 1}] {-1, 1, 1, 1, 1, -1, -1, 0, -1, 1, 1, -1, -1, -1, 1, -1, 1, 1, -1, 0, 1, -1, -1, 1, -1, -1, 1, 1, -1, 1} Total @ % 0 You can also do RandomSample @ PadRight[Flatten @ ConstantArray[{1, -1}, RandomChoice[...


13

If you don't care about extra space, we can employ a reverse lookup table: seenQ[0] = True; a[0] = 0; a[n_] := a[n] = With[{prev = a[n - 1]}, (seenQ[#] = True; #) &[ If[prev > n && ! TrueQ[seenQ[prev - n]], prev - n, prev + n] ] ] Block[{$RecursionLimit = ∞}, Do[a[k], {k, 10^6}] // AbsoluteTiming ] {8.55911, Null} a /@ Range[0, ...


13

You can use Split: Last /@ Split[z, #2 == # + 1&] {113, 121, 476, 529, 538, 544} First /@ Split[z, #2 == # + 1&] {113, 117, 475, 529, 538, 542}


12

f[n_]:=Union @@ NestList[{{0,1},{1,1}}.# &, {1, 1}, n] EDIT fib[n_]:=NestList[{{0,1},{1,1}}.# &, {0, 1}, n][[All,1]] and MatrixPower method: fn[n_]:=First[MatrixPower[{{1,1},{1,0},n-1].{1,0}]


12

There is a straightforward answer analogous to that in Maple : Coefficient[ Sum[t^i, {i, 5}] Sum[t^i, {i, 2, 6}] Sum[t^i, {i, 3, 9}], t, 15] 19 This can be verified by expanding the polynomial: Expand[ Sum[t^i, {i, 5}] Sum[t^i, {i, 2, 6}] Sum[t^i, {i, 3, 9}]] However you can do it in many different ways e.g. by exploiting CoefficientRules or ...


12

Defining the "Collatz"-Function like you did is straight-forward, but in the sense of Mathematica not optimal. When computing the length of a Collatz-Sequence a lot of duplicate calculations are done. So defining: collatz[n_] := collatz[n] = If[EvenQ[n], n/2, 3*n + 1] prevents Mathematica from doing duplicate evaluation. This is more efficient than ...


12

LinearRecurrence is useful here: LinearRecurrence[{1, 1, 1}, {1, 1, 2}, 9] {1, 1, 2, 4, 7, 13, 24, 44, 81} Related: Fibonacci Sequence Generator How to deal with recursion formula in Mathematica?


12

Brute-force, but compact: DeleteCases[Table[{k, PowersRepresentations[k!, 3, 2]}, {k, 10}], {___, 0, ___}, {3}] {{1, {}}, {2, {}}, {3, {{1, 1, 2}}}, {4, {{2, 2, 4}}}, {5, {{2, 4, 10}}}, {6, {{8, 16, 20}}}, {7, {{4, 20, 68}, {12, 36, 60}, {20, 44, 52}}}, {8, {{8, 16, 200}, {8, 80, 184}, {40, 88, 176}, {72, 120, 144}, {80, 104, 152}}}, {9, {{8, 304, 520}, ...


11

In Mathematica 10.2 one can use the new function SequenceFoldList: fib[n_] := SequenceFoldList[Plus, {0, 1}, ConstantArray[0, n - 1]]; fib[15] {0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610} Use SequenceFold to obtain just the last element.


11

@Artes's use of Coefficient certainly seems the most straightforward and probably the best for small examples. If the polynomials have very many terms, the use of SeriesData to represent the polynomials will give better performance. The multiplication of series is efficient in Mathematica. One should note that it is truncated beyond the maximum degree ...


11

Recursive Function Let's start with simple recursive function provided by @corey979: ClearAll[fRecursive] fRecursive[1] = 2; fRecursive[n_] := fRecursive[n] = Count[Table[fRecursive[k], {k, 1, n-2}], fRecursive[n - 1]] It works as expected: Array[fRecursive, 15] (* {2, 0, 0, 1, 0, 2, 1, 1, 2, 2, 3, 0, 3, 1, 3} *) but it's a bit slow: Table[...


11

I took it as a challenge to avoid using Solve, which can be slower than a direct assault. If $a$ is the first number in the sum of consecutive positive integers, and $k$ is the count of integers summing to $n$, then $n=k*a+k(k-1)/2$. Solve this for $a=n/k-(k-1)/2$, with bounds $1 \le k \le {\rm Floor}[(\sqrt{8n+1}-1)/2]$. Consider the odd and even divisors ...


11

Have you thought about whether this is a reasonable thing to try to compute exactly? There is a closed form formula for Fibonacci numbers which allows us to estimate the number of digits in the answer: Fibonacci[k] // FunctionExpand (* ((1/2 (1 + Sqrt[5]))^k - (2/(1 + Sqrt[5]))^k Cos[k π])/Sqrt[5] *) For large k the answer is approximately GoldenRatio^k /...


11

you mean something like this? Graphics[{Red, Rectangle[{0, 0}, {Fibonacci@6, Fibonacci@5}], Green, Rectangle[{0, 0}, {Fibonacci@4, Fibonacci@5}], Yellow, Rectangle[{0, 0}, {Fibonacci@4, Fibonacci@3}], Blue, Rectangle[{0, 0}, {Fibonacci@2, Fibonacci@3}], Pink, Rectangle[{0, 0}, {Fibonacci@2, Fibonacci@1}]}] but if you want the real thing, here ...


11

Using an undocumented function (see this as well) to implement the matrix form of the Fibonacci recurrence (see this as well): With[{n = 1003, m = 8}, Algebra`MatrixPowerMod[{{1, 1}, {1, 0}}, n - 1, 10^m][[1, 1]]] 96035877 Mod[Fibonacci[1003], 1*^8] 96035877


10

You need to specify assumptions: In[1]:= FunctionExpand[StirlingS2[n, 10], n > 0 && Mod[n, 1] == 0] Out[1]= -(1/362880) + 2^(-8 + n)/315 + 1/135 2^(-7 + 2 n) + 1/315 2^(-8 + 3 n) - 3^(-3 + n)/1120 + 1/5 2^(-7 + n) 3^(-3 + n) - 5^(-2 + n)/576 + 1/567 2^(-8 + n) 5^(-2 + n) - 7^(-1 + n)/4320 - 9^(-2 + n)/4480


10

Also taking your question at face value, but making the fix faster: fibonacciSequence2[n_] := Module[ {fPrev = 0, fNext = 1, i = 0, list = {0}}, While[i++ < n, {fPrev, fNext} = {fNext, fPrev + fNext}; list = {fPrev, list} ]; Reverse@Flatten[list] ] fibonacciSequence2[5000] // Timing This way of constructing a list has a name, it's ...


Only top voted, non community-wiki answers of a minimum length are eligible