39

There is a Mathematica package exactly for this at the OEIS wiki. Somewhat related: there's also a package for formatting data into the OEIS format. WolframAlpha also has some of this information, though I'm not sure how to get the $n^{\mathrm{th}}$ term of the sequence. In[1] := WolframAlpha["A004001", {{"TermsPod:IntegerSequence", 1}, "ComputableData"}] ...


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


21

A bit of a hack, could do with some polishing, but the basic idea will work: OEISData[str_] := StringSplit[#, ","] & /@ Select[StringSplit[Import["http://oeis.org/search?q=" <> str]], StringMatchQ[#, __ ~~ ","] &]; OEISData["A004001"][[9]] If you just want the numbers, it could be even easier to just import from http://oeis.org/...


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


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}


15

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}


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

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


14

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


14

I liked Szabolcs’ answer but would like to remind about free form input here. We get so much information using it for very little typing. Plus we get native to M. format. For those who does not know this yet - at the beginning of new input line press equal sign “=” twice to get orange spiky and then type in free form. In this case you see result below. This ...


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


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


12

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


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

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


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


10

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


9

This may do what you want: Clear["`*"]; fibonacciSequence[n_] := Module[{fPrev = 1, fNext = 0}, Table[{fPrev, fNext} = {fNext, fPrev + fNext}, {n + 1}][[;; , 1]] ] fibonacciSequence[15] (* {0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610} *) a = 1; b = 0; Table[b = a + (a = b), {10}] NestList[{+##, #} & @@ # &, {1, 1}, 10][[;; , 1]...


9

f[1] = 2; To compute $x_{n+1}$ you want to check how many $x_n$'s are in the set $\{x_1,\ldots,x_{n-1}\}$, i.e. for f[n] you want to generate a Table of {f[1],...,f[n-2]}: Table[f[k], {k, 1, n - 2}] and count how many f[n-1]'s are there: f[n_] := Count[Table[f[k], {k, 1, n - 2}], f[n - 1]] Alternatively, you can shift the index by 1 (which doesn't ...


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