# Tag Info

4

You came close; you can almost transcribe the equations and then let Mathematica do the recursion for you. This isn't necessarily the most efficient way to do things, but it makes up for that in simplicity, and given the size of your problem it's plenty fast enough. First, let's get rid of any stale definitions: Clear[f, x, y]; Then let's define our ...

4

Candidate initial conditions: mat = {{1, 1}, {1, 0}}; res = MatrixPower[mat, 7,{a, b}]; Reduce[res[[1]] == 120, {a, b}, Integers] yields: C1 [Element] Integers && a == 2 + 13 C1 && b == 6 - 21 C1 fun[x_] := {2 + 13 x, 6 - 21 x} The constraint of sequence of positive integers: Reduce[Positive[fun[x]], x, Integers] yields $x=0$ and is ...

3

The following retains only Lists that are strictly decreasing and contain no negative elements. Cases[seqs, {z1_, z2_, z3_, z4_, z5_, z6_, z7_} /; z1 > z2 > z3 > z4 > z5 > z6 > z7 > 0] (* {{120, 74, 46, 28, 18, 10, 8}} *) or, more succinctly (see comments below), Cases[seqs, {z__} /; Greater[z, -1]] Additionally, the second code ...

5

Pick lists that don't contain negative number: Pick[seqs, UnitStep @@@ seqs, 1] {{120, 72, 48, 24, 24, 0, 24}, {120, 73, 47, 26, 21, 5, 16}, {120, 74, 46, 28, 18, 10, 8}, {120, 75, 45, 30, 15, 15, 0}} Pick non-increasing lists: Pick[seqs, UnitStep @@@ -Differences /@ seqs, 1] {{120, 74, 46, 28, 18, 10, 8}, {120, 75, 45, 30, 15, 15, 0}} And ...

0

You really want to define the collection of vs when you produce a realization of vel, so I'd replace this with vel[n_] := Module[{}, Table[ v[k] = v[k - 1] + f[k - 1] + Random[NormalDistribution[0, s]], {k, 0, n}] ] This generates a new set of vs every time you call vel[]. (The bulk of this could be replaced by NestList[], but I'm not convinced ...

1

I'm quite certain that the intention of the author (Alan Beardon?) is that you conjugate the function by the appropriate Möbius transformation to see that its dynamics are quite simple when looked at from the right angle. The process is pretty simple, but you can use Mathematica to assist, if desired. The function has a single, repeated fixed point at ...

13

Suggested solution If I understood the question right, then the simplest solution here would probably be to define a helper function like the following: vv[n_] := InternalInheritedBlock[{v}, v /@ Range[n]]; Then, you get vel = vv[m] and every run of vv would result in different set of values, while the values in the set will all come from the same ...

0

This is not a proof but I post it just for fun. In the following the iterated Möbius transform is compared with the proposed solution in complex plane and on Riemann sphere... spc[x_, y_] := {2 x, 2 y, -1 + x^2 + y^2}/(1 + x^2 + y^2) mt[a_, b_, c_, d_][x_, y_] := Through[{Re, Im}[(a x + a I y + b)/(c x + c I y + d)]]. fun = mt[3, -2, 2, -1] g[n_] := mt[2 ...

5

One way to solve this is to use FindSequenceFunction. First define the iteration r[z_] := FullSimplify[(3 z - 2)/(2 z - 1)]; So that, for example, the first four terms are: Nest[r, z, #] & /@ Range[4] {(2 - 3 z)/(1 - 2 z), (4 - 5 z)/(3 - 4 z), (6 - 7 z)/(5 - 6 z), (8 - 9 z)/(7 - 8 z)} To get the general form, feed several of these terms into ...

8

As it turns out, RSolve[] is capable of handling this: FullSimplify[RSolve[{f[n] == (3 f[n - 1] - 2)/(2 f[n - 1] - 1), f[0] == z}, f[n], n], n ∈ Integers] {{f[n] -> (2 n (-1 + z) + z)/(1 + 2 n (-1 + z))}} Extra Credit Explain the following observations: f[n_, z_] := ((2 n + 1) z - 2 n)/(2 n z - (2 n - 1)) y /. First[Solve[z ...

1

Here is another recursive implementation of the Bickley(-Nayler) function, using Leonid's method from here: SetAttributes[BickleyKi, Listable]; BickleyKi[n_Integer?NonPositive, z_] := (-1)^n Derivative[0, -n][BesselK][0, z]; BickleyKi[1, z_] := π (1 - z BesselK[{0, 1}, z].StruveL[{-1, 0}, z])/2; BickleyKi[n_Integer, z_] := Module[{zl}, Set @@ ...

0

Along with @J.M.'s superfast solution, and this nice little identity, where for $X_j \text{ iid},$ uniformly distributed on $[0,1],$ $$\dfrac{1}{n!} \left\langle n \atop k \right\rangle = P\left(\sum_{j=1}^{n}X_j\in[k,k+1]\right)$$ we can get eg eulplot[6, 2], eulplot[12, 5]: eulerian[k_, n_] := CoefficientList[(1 - x)^(n + 1) PolyLog[-n, x]/x, x][[k ...

1

I like this (equivalent) one better: ClearAll[sd]; t = Transpose; sd@{} = 1; sd@m_:= sd@m= sd@t@m= m[[1,1]] /; Length@m == 1 sd@m_:= sd@m= sd@t@m= Sum[m[[1,j]] (-1)^(j + 1) sd@Drop[m,{1},{j}], {j, Length@m}]

2

This is how I would write it: sneakydeterminant[m_] := sneakydeterminant[m] = sneakydeterminant[Transpose[m]] = If[Length[m] == 1, m[[1, 1]]], Sum[Power[-1, j + 1] m[[1, j]] sneakydeterminant[ m[[Complement[Range[Length[m]], {1}], Complement[Range[Length[m]], {j}]]]], {j, 1, Length[m]}] The only difference is the ...

2

Use Rationalize to convert input lists to exact numbers. list1 = {1. + I, 2. + 0.2 I, 1. + I, 2. + 0.2 I, 1. + I, 2. + 0.2 I}; ker1 = FindLinearRecurrence[list1 // Rationalize] (* {0, 1} *) list1 == LinearRecurrence[ker1, list1[[1 ;; 2]], Length[list1]] (* True *) list2 = {6.683982467191557 - 0.7362491053693563 I, -1, 6.683982467191557 - ...

2

@Winther's solution is particularly fast from here adapted slightly: pwf[z_] := Piecewise[{z[[#]], # - 1 <= y < #} & /@ Range@Length@z] iidf[n_] := With[{nn = n}, ffunc = Table[If[i == 1, 1, 0], {i, 1, n}]; Do[temp = ffunc; temp[[1]] = Integrate[ffunc[[1]], {z, 0, z}]; Do[temp[[k]] = Integrate[ffunc[[k - 1]], {z, z - 1, k - 1}] + ...

7

Adapting once again Leonid's solution from here, f[1, z_] := UnitBox[z - 1/2]; f[n_Integer, z_] := Module[{zl, t}, Set @@ Hold[f[n, zl_], Simplify[Convolve[UnitBox[t - 1/2], f[n - 1, t], t, zl]]]; f[n, z]]; f[4, z] \$\displaystyle\begin{cases} -\frac16(-4+z)^3&3\le ...

5

f[1] = Integrate[PDF[UniformDistribution[{0, 1}], z - y], {y, 0, 1}] /. z -> y; f[n_] := f[n] = Integrate[f[n - 1] /. y -> z - y, {y, 0, 1}] /. z -> y // Simplify; f[3]

2

f[0] := 0 f[1] := 0 f[2] := 1 f[x_] := Module[{j = 1}, While[Mod[x, j] == 0, j++]; j]; bt[x_] := Nest[f, x, 3] Total[bt /@ Range[2006]] yields 1171

6

You made a few mistakes. jk[0] should be 0 in your code and your function tr is wrong. Corrected version: t[0] = 0; t[1] = 0; t[2] = 1; t[n_] := t[n] = LengthWhile[Range[1, 11], Divisible[n, #1] &] + 1 Sum[Nest[t, m, 3], {m, 1, 2006}] 1171 10x faster version: t[n_] := t[n] = Module[{i = 1}, While[MemberQ[Divisors[n], i], i++]; i];

0

I like everyone's answers, but it seems to me that your first approach is most appropriate for a 11-year-old kid new to MMA. Keep it simple and leave the pure functions and exotic syntax for another day. :) Perhaps something like this: next[list_] := Append[list, list[[-1]] + list[[-2]]] So that next[{0, 2, 2, 4}] returns {0,2,2,4,6} Then ...

Top 50 recent answers are included