Suppose I have this Mathematica code, whose output, a real number, depends on the input, say, x,y,z. How do I make a real-valued function in x,y,z based on the code?
If the code describes a simple relationship among x,y,z, I could define this function directly. The point here is that the given code is a very complicated block (or module).
For example, if the code simply sums x,y,z, I would simply define
f[x_,y_,z_]=x+y+z
What if I have a very complex example, like the one below:
s0[a_, b_, x_] :=
{1, 0, (a + b) x + (1 - a - b)}
s1[a_, b_, c_, d_, p_, q_, n_, x_] :=
Which[0 <= x <= c, {2, n - 1, x/c*q + p},
c <= x <= c + d, {2, n, (x - c)/d*p},
c + d <= x <= 1, {1, n + 1, (x - (c + d))/(1 - c - d)*(1 - a - b)}]
s2[s_, t_, c_, d_, p_, q_, n_, x_] :=
Which[0 <= x <= 1 - s - t, {2, n - 1,
x/(1 - s - t)*(1 - p - q) + p + q},
1 - s - t <= x <= 1 - s, {3,
n - 1, (x - (1 - s - t))/t*(1 - c - d) + c + d},
1 - s <= x <= 1, {3, n, (x - (1 - s))/s*d + c}]
s3[c_, a_, b_, s_, t_, n_, x_] :=
Which[0 <= x <= 1 - a - b, {4, n - 1, x/(1 - a - b)*t + 1 - s - t},
1 - a - b <= x <= 1 - a, {4, n, (x - (1 - a - b))/b*(1 - s - t)},
1 - a <= x <= 1, {3, n + 1, (x - (1 - a))/a*c}]
s4[p_, q_, s_, a_, b_, n_, x_] :=
Which[0 <= x <= p, {4, n - 1, x/p*s + 1 - s},
p <= x <= p + q, {5, n - 1, (x - p)/q*a/(a + b) + b/(a + b)},
p + q <= x <= 1, {5, n, (x - (p + q))/(1 - p - q)*b/(a + b)}]
F[{k_, n_, x_}] :=
Which[k == 0, s0[a, b, x],
k == 1, s1[a, b, c, d, p, q, n, x],
k == 2, s2[s, t, c, d, p, q, n, x],
k == 3, s3[c, a, b, s, t, n, x],
k == 4, s4[p, q, s, a, b, n, x]]
G[x_] := NestWhile[F, {0, 0, x}, Function[e, Extract[e, {1}] != 5]]
H[x_] := Extract[G[x], {2}] + Extract[G[x], {3}]
H[0]
For the above code to run, one needs to specify the list
{a,b,c,d,p,q,s,t}
And the output are real numbers. How does one define a function in a,b,c,d,p,q,s,t that spits out these real numbers?
Your essential problem is that you have a large number of parameters in your auxiliary functions, but your big-letter functions (F, G and H and by the way single-capital-letter function names in Mathematica are a bad idea) only take three parameters and your auxiliary functions (s0 etc) only return three values in the returned list.
You have two possible ways to fix this.
You can either redefine everything to require all the parameters required in the whole system - I'm assuming that common parameter names across the auxiliary functions really are common values - like this:
G[x_, a_, b_, c_, d_, p_, q_, s_, t_] :=
NestWhile[F, {0, 0, x, a, b, c, d, p, q, s, t},
Function[e, Extract[e, {1}] != 5]]
or
You can set some options that set these parameters globally for the whole system. Look up Options and OptionsPattern. You would do something like this:
First, define default options:
Options[mySystem] = {aa -> 0.2, bb -> 1., cc -> 2., dd -> 4.,
pp -> 0.2, qq -> 0.1, ss -> 10., tt -> 20.}
SetOptions[mySystem, {aa->0.2, bb->1., cc->2., dd->4., pp->0.2,
qq->0.1, ss->10., tt->20.}]
Then write your functions like this:
F[{k_, n_, x_}, OptionsPattern[mySystem]] :=
With[{a = OptionValue[aa], b = OptionValue[bb], c = OptionValue[cc],
d = OptionValue[dd], p = OptionValue[pp], q = OptionValue[qq],
s = OptionValue[ss], t = OptionValue[tt]},
Which[k == 0, s0[a, b, x], k == 1, s1[a, b, c, d, p, q, n, x],
k == 2, s2[s, t, c, d, p, q, n, x], k == 3,
s3[c, a, b, s, t, n, x], k == 4, s4[p, q, s, a, b, n, x]] ]
There is also something quite wrong with your use of Extract (you are assuming there are more parts in your list than are actually there in the first few iterations), but this answers your main issue.
I need to find fixed points of iterative map x[n] == 1/2 x[n-1]^2 - Mu.
My approach:
Subscript[g, n_ ][Mu_, x_] := Nest[0.5 * x^2 - Mu, x, n]
fixedPoints[n_] := Solve[Subscript[g, n][Mu, x] == x, x]
Plot[
Evaluate[{x,
Table[Subscript[g, 1][Mu, x], {Mu, 0.5, 4, 0.5}]}
], {x, 0, 0.5}, Frame -> True]
I'll change notation slightly (mostly so I myself can understand it). You might want something like this.
y[n_, mu_, x_] := Nest[#^2/2 - mu &, x, n]
fixedPoints[n_] := Solve[y[n, mu, x] == x, x]
The salient feature is that the "function" being nested now really is a function, in correct format.
Example:
fixedPoints[2]
Out[18]= {{x -> -1 - Sqrt[-3 + 2*mu]},
{x -> -1 + Sqrt[-3 + 2*mu]},
{x -> 1 - Sqrt[ 1 + 2*mu]},
{x -> 1 + Sqrt[ 1 + 2*mu]}}
Daniel Lichtblau
First of all, there is an error in your approach. Nest takes a pure function. Also I would use exact input, i.e. 1/2 instead of 0.5 since Solve is a symbolic rather than numeric solver.
Subscript[g, n_Integer][Mu_, x_] := Nest[Function[z, 1/2 z^2 - Mu], x, n]
Then
In[17]:= fixedPoints[1]
Out[17]= {{x -> 1 - Sqrt[1 + 2 Mu]}, {x -> 1 + Sqrt[1 + 2 Mu]}}
A side note:
Look what happens when you start very near to a fixed point (weird :) :
f[z_, Mu_, n_] := Abs[N#Nest[1/2 #^2 - Mu &, z, n] - z]
g[mu_] := f[1 + Sqrt[1 + 2*mu] - mu 10^-8, mu, 10^4]
Plot[g[mu], {mu, 0, 3}, PlotRange -> {0, 7}]
Edit
In fact, it seems you have an autosimilar structure there:
I have a function, let's say for example,
D[x^2*Exp[x^2], {x, 6}] /. x -> 0
And I want to replace 6 by a general integer n,
Or cases like the following:
Limit[Limit[D[D[x /((-1 + x) (1 - y) (-1 + x + x y)), {x, 3}], {y, 5}], {x -> 0}], {y -> 0}]
And I want to replace 3 and 5 by a general integer m and n respectively.
How to solve these two kinds of problems in general in mma?
Many thanks.
Can use SeriesCoefficient, sometimes.
InputForm[n! * SeriesCoefficient[x^2*Exp[x^2], {x,0,n}]]
Out[21]//InputForm=
n!*Piecewise[{{Gamma[n/2]^(-1), Mod[n, 2] == 0 && n >= 2}}, 0]
InputForm[mncoeff = m!*n! *
SeriesCoefficient[x/((-1+x)*(1-y)*(-1+x+x*y)), {x,0,m}, {y,0,n}]]
Out[22]//InputForm=
m!*n!*Piecewise[{{-1 + Binomial[m, 1 + n]*Hypergeometric2F1[1, -1 - n, m - n,
-1], m >= 1 && n > -1}}, 0]
Good luck extracting limits for m, n integer, in this second case.
Daniel Lichtblau
Wolfram Research
No sure if this is what you want, but you may try:
D[x^2*Exp[x^2], {x, n}] /. n -> 4 /. x -> 0
Another way:
f[x0_, n_] := n! SeriesCoefficient[x^2*Exp[x^2], {x, x0, n}]
f[0,4]
24
And of course, in the same line, for your other question:
f[m_, n_] :=
Limit[Limit[
D[D[x/((-1 + x) (1 - y) (-1 + x + x y)), {x, m}], {y, n}], {x ->
0}], {y -> 0}]
These answers don't give you an explicit form for the derivatives, though.
I want to do the following in Mma. Suppose I have three expressions, x1, 3 x1-x2, x2-x1 where 0<=x1,x2<=1). I want to have another one which specifies the largest among the three is at least twice of the smallest. So there are some permutation of the three in terms of their order:
x1<=3 x1-x2<=x2-x1 && 2 x1<=x2-x1
3 x1-x2<=x1<=x2-x1 && 2 (3 x1-x2)<=x2-x1
....
with the rest 4 similar conditions.
How do I form these conditions automatically (together with 0<=x1,x2<=1), and then feed them into Reduce one-by-one, and solve for x2 in terms of x1?
Many thanks!
eqs = {x1, 3 x1 - x2, x2 - x1};
Reduce[Max[eqs] >= 2 Min[eqs], {x1, x2}, Reals]
If you want to do comparisons with second-largest or third largest/smallest then can use RankedMax
As far as solving it for x2 -- there are many different values of x2 corresponding to each x1 so you can't solve it in the conventional sense, you can see it from RegionPlot
RegionPlot[Max[eqs] >= 2 Min[eqs], {x1, 0, 1}, {x2, 0, 1}, PlotPoints -> 100]
Use Max and Min and specify x2 before x1 in the variable list, as follows
In[1]:= Reduce[
Max[x1, 3 x1 - x2, x2 - x1] >= 2 Min[x1, 3 x1 - x2, x2 - x1] &&
0 <= x1 && x2 <= 1,
{x2, x1}]