# Tag Info

2

I use Array to build up a list of functions for each level of the recursion. Each of those functions takes the next sum as its argument. For example, here is this intermediate list: Then I use Composition to nest all the functions, and apply the entire function to 1. foo = Function[{m, j, n}, (Composition @@ Array[ Function[i, ...

0

In order to make my answer more comprehensible I decoupled the set of equations first: (*1*) H[n+1]==7/10*H[n](17/7-H[n]) (*2*) h[n+1]==7/10*h[n](3/7+h[n]) with the constraints: (h[n]+H[n]==1) && (0<=H[n]<=1) && (0<=h[n]<=1) These can be obtained by using h[n]+H[n]==1. The recurence relations can now be solved independently. ...

2

You could also just program iteratively: f[{x_, y_}] := With[{ch = {1, 0.7 x}.{x, y}}, {ch, 1 - ch}] hdt[p_, n_] := Transpose@NestList[f, {p, 1 - p}, n] If you just want $\{H(n),h(n)\}$ for starting values $\{H(0),h(0)\}=\{p,1-p\}$: hd[p_, n_] := Nest[f, {p, 1 - p}, n]; Visualizing: lp[p_] := ListPlot[hdt[p, 10], Joined -> True, PlotMarkers -> ...

0

You could also do something like: GraphicsRow[ListLinePlot@Transpose@RecurrenceTable[{ H[n + 1] == N@(1 + (7 h[n])/10) H[n], h[n + 1] == N@1 - (1 + (7 h[n])/10) H[n], H[0] == #/100, h[0] == 1/2}, {H[n], h[n]}, {n, 1, 15}] & /@ {179, 180}]

2

I know it doesn't answer your question directly, but with the definition above, your function H[n] asymptotically approaches 1 pretty fast regardless of the starting value H[0]: (* Generates a table for the first 20 values of H given H[0] == alpha *) f[alpha_] := Module[{H}, H[0] = alpha; H[n_] := H[n] = H[n - 1] (1 + .7 (1 - H[n - 1])); Table[H[n], ...

3

Look at the unsimplified UnitStep nonsense in Mathematica’s result. For example, the expression (1 - x - y)^K[1] UnitStep[-1 + K[1]] + UnitStep[-K[1]] really just ought to be (1 - x - y)^K[1] instead. So let’s write a unitStepSimplify function to simplify expressions containing that, and apply it: unitStepSimplify = # /. {UnitStep[-i_] + f_ UnitStep[i_ - 1] ...

3

This is quite strightforward; a[n_, p_: 3, g_: 2, c_: 1] := a[n] = If[Divisible[a[n - 1], p], a[n - 1]/p, g a[n - 1] + c] Manipulate[ a[0] = a0; DiscretePlot[a[x, p, g, c], {x, 1, 50}, BaseStyle -> {Bold, 18}], {{p, 3}, 2, 10, 1}, {{g, 1}, 0, 10, 1}, {{c, 1}, 0, 10, ...

6

Maybe try something like ClearAll@plotter plotter[s_, h_] := plotter[s, h] = ListPlot[RecurrenceTable[{x[t + 1] == N[(x[t]^2 + x[t] (1 - x[t]) (1 - s h))/(x[t]^2 + 2 x[t] (1 - x[t]) (1 - s h) + (1 - x[t])^2 (1 - s))], x[0] == 7}, x, {t, 0, 16}] , PlotRange -> {0, 1} ] Manipulate[plotter[s, h], {{s, 1}, 1, 5, 1}, ...

Top 50 recent answers are included