Related
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.
Evaluating the following integral should be non-zero, and mathematica correctly gives a non-zero result
Integrate[ Cos[ (Pi * x)/2 ]^2 * Cos[ (3*Pi*x)/2 ]^2, {x, -1, 1}]
However, attempting a more general integral:
FullSimplify[
Integrate[Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/2],
{x, -1, 1}],
Element[{m, n}, Integers]]
yields zero, which is definitely not true for m = n = 1
I'd expect a conditional expression. Is it possible to "tell" mathematica about my constraints on m and n before the integral is evaluated so that it handles the special cases properly?
While I'm late to the party, no one has given a complete solution, thus far.
Sometimes, it pays to understand the integrand better before you integrate. Consider,
ef = TrigReduce[
Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/2]]/.
Cos[a_] :> Cos[ Simplify[a, Element[{m,n}, Integers] ] ]
which returns
(2 Cos[(m - n) Pi x] + Cos[(1 + m - n) Pi x] + Cos[(1 - m + n) Pi x] +
Cos[(m + n) Pi x] + 2 Cos[(1 + m + n) Pi x] + Cos[(2 + m + n) Pi x] )/8
where each term has the form Cos[q Pi x] with integral q. Now, there are two cases to consider when integrating Cos[q Pi x] over -1 to 1 (where q is integral): q == 0 and q != 0.
Case q = 0: This is a special case that Mathematica misses in the general result, as it implies a constant integrand. (I'll often miss it, also, when doing this by hand, so Mathematica isn't entirely to blame.) So, the integral is 2, in this case.
Strictly speaking, this isn't true. When told to integrate Cos[ q Pi x ] over -1 < x < 1, Mathematica returns
2 Sin[ Pi q ]/( Pi q )
which is 0 except when q == 0. At that point, the function is undefined in the strict sense, but Limit[Sin[x]/x, q -> 0] == 1. As the singularity at q == 0 is removable, the integral is 2 when q -> 0. So, Mathematica does not miss it, it is just in a form not immediately recognized.
Case q != 0: Since Cos[Pi x] is periodic with period 2, an integral of Cos[q Pi x] from x == -1 to x == 1 will always be over q periods. In other words,
Integrate[ Cos[q Pi x], {x, -1, 1},
Assumptions -> (Element[ q, Integers ] && q != 0) ] == 0
Taken together, this means
Integrate[ Cos[q Pi x], {x, -1, 1}, Assumptions -> Element[ q, Integers ] ] ==
Piecewise[{{ q == 0, 2 }, { 0, q!=0 }}]
Using this, we can integrate the expanded form of the integrand via
intef = ef /. Cos[q_ Pi x] :> Piecewise[{{2, q == 0}, {0, q != 0}}] //
PiecewiseExpand
which admits non-integral solutions. To clean that up, we need to reduce the conditions to only those that have integral solutions, and we might as well simplify as we go:
(Piecewise[{#1,
LogicalExpand[Reduce[#2 , {m, n}, Integers]] //
Simplify[#] &} & ### #1, #2] & ## intef) /. C[1] -> m
\begin{Edit}
To limit confusion, internally Piecewise has the structure
{ { { value, condition } .. }, default }
In using Apply (##), the condition list is the first parameter and the default is the second. To process this, I need to simplify the condition for each value, so then I use the second short form of Apply (###) on the condition list so that for each value-condition pair I get
{ value, simplified condition }
The simplification process uses Reduce to restrict the conditions to integers, LogicalExpand to help eliminate redundancy, and Simplify to limit the number of terms. Reduce internally uses the arbitrary constant, C[1], which it sets as C[1] == m, so we set C[1] back to m to complete the simplification
\end{Edit}
which gives
Piecewise[{
{3/4, (1 + n == 0 || n == 0) && (1 + m == 0 || m == 0)},
{1/2, Element[m, Integers] &&
(n == m || (1 + m + n == 0 && (m <= -2 || m >= 1)))},
{1/4, (n == 1 + m || (1 + n == m && (m <= -1 || m >= 1)) ||
(m + n == 0 && (m >= 1 || m <= 0)) ||
(2 + m + n == 0 && (m <= -1 || m >= 0))) &&
Element[m, Integers]},
{0, True}
}
as the complete solution.
Another Edit: I should point out that both the 1/2 and 1/4 cases include the values for m and n in the 3/4 case. It appears that the 3/4 case may be the intersection of the other two, and, hence, their sum. (I have not done the calc out, but I strongly suspect it is true.) Piecewise evaluates the conditions in order (I think), so there is no chance of getting this incorrect.
Edit, again: The simplification of the Piecewise object is not as efficient as it could be. At issue is the placement of the replacement rule C[1] -> m. It happens to late in the process for Simplify to make use of it. But, if it is brought inside the LogicalExpand and assumptions are added to Simplify
(Piecewise[{#1,
LogicalExpand[Reduce[#2 , {m, n}, Integers] /. C[1] -> m] //
Simplify[#, {m, n} \[Element] Integers] &} & ### #1, #2] & ## intef)
then a much cleaner result is produce
Piecewise[{
{3/4, -2 < m < 1 && -2 < n < 1},
{1/2, (1 + m + n == 0 && (m >= 1 || m <= -2)) || m == n},
{1/4, 2 + m + n == 0 || (m == 1 + n && m != 0) || m + n == 0 || 1 + m == n},
{0, True}
}]
Not always zero ...
k = Integrate[
Cos[(Pi x)/2]^2 Cos[((2 (n) + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/ 2],
{x, -1, 1}, Assumptions -> Element[{m, n}, Integers]];
(*Let's find the zeroes of the denominator *)
d = Denominator[k];
s = Solve[d == 0, {m, n}]
(*The above integral is indeterminate at those zeroes, so let's compute
the integral again there (a Limit[] could also do the work) *)
denZ = Integrate[
Cos[(Pi x)/2]^2 Cos[((2 (n) + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/ 2] /.s,
{x, -1, 1}, Assumptions -> Element[{m, n}, Integers]];
(* All possible results are generated with m=1 *)
denZ /. m -> 1
(*
{1/4, 1/2, 1/4, 1/4, 1/2, 1/4}
*)
Visualizing those cases:
Plot[Cos[(Pi x)/2]^2 Cos[((2 (n) + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/2]
/. s /. m -> 1, {x, -1, 1}]
Compare with a zero result integral one:
Plot[Cos[(Pi x)/2]^2 Cos[((2 (n) + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/ 2]
/. {m -> 1, n -> 4}, {x, -1, 1}]
If you just drop the whole FullSimplify part, mathematica does the integration neatly for you.
Integrate[
Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/
2], {x, -1, 1}]
To include the condition that m and n are integers, it's better to use the Assumptions option in Integrate.
Integrate[
Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/
2], {x, -1, 1}, Assumptions -> Element[{m, n}, Integers]]
Lets use some conclusive conditions about the two integers m=n||m!=n.
Assuming[{(n \[Element] Integers && m \[Element] Integers && m == n)},
Integrate[Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/2],
{x, -1, 1}]]
The answer for this case is 1/2. For the other case it is
Assuming[{(n \[Element] Integers && m \[Element] Integers && m != n)},
Integrate[
Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/
2], {x, -1, 1}]]
and the answer is 0.
However I am amazed to see that if we add this two conditions as an "either or stuff", Mathematica returns one zero after integration. I mean in case of the following I am getting only zero but not ``1/2||0`.
Assuming[{(n \[Element] Integers && m \[Element] Integers &&
m == n) || (n \[Element] Integers && m \[Element] Integers &&
m != n)},
Integrate[
Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/
2], {x, -1, 1}]]
By the way we can see the conditions exclusively where this integral becomes Indeterminate.
res = Integrate[
Cos[(Pi x)/2]^2 Cos[((2 n + 1) Pi x)/2] Cos[((2 m + 1) Pi x)/
2], {x, -1, 1}] // Simplify
The output is here.
Now lets see all the relations m and n can have to make the Integral bad!
BadPart = (res*4 Pi);
Flatten#(Solve[(Denominator[#] == 0), m] & /#
Table[BadPart[[i]], {i, 1, Length#BadPart}] /.
Rule -> Equal) // TableForm
So these are the special cases which as Sjoerd mentioned are having infinite instances.
BR
I am using NDSolve to solve a non-linear partial differential
equation.
I'd like one of the variables (Kvar) to be a function
of the time step currently being solved and hence and using
Piecewise.
Mathematica generates an error message saying:
SetDelayed::write: Tag Real in 0.05[t_] is Protected. >>
NDSolve::deqn: Equation or list of equations expected instead of
$Failed in the first argument ....
ReplaceAll::reps: ....
I haven't included the entire error message for ease of reading.
My code is as follows:
Needs["VectorAnalysis`"]
Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];
Clear[Eq4, EvapThickFilm, h, S, G, E1, K1, D1, VR, M, R]
Eq4[h_, {S_, G_, E1_, K1_, D1_, VR_, M_, R_}] := \!\(
\*SubscriptBox[\(\[PartialD]\), \(t\)]h\) +
Div[-h^3 G Grad[h] +
h^3 S Grad[Laplacian[h]] + (VR E1^2 h^3)/(D1 (h + K1)^3)
Grad[h] + M (h/(1 + h))^2 Grad[h]] + E1/(
h + K1) + (R/6) D[D[(h^2/(1 + h)), x] h^3, x] == 0;
SetCoordinates[Cartesian[x, y, z]];
EvapThickFilm[S_, G_, E1_, K1_, D1_, VR_, M_, R_] :=
Eq4[h[x, y, t], {S, G, E1, K1, D1, VR, M, R}];
TraditionalForm[EvapThickFilm[S, G, E1, K1, D1, VR, M, R]];
And the second cell where I am trying to implement Piecewise in NDSolve:
L = 318; TMax = 7.0;
Off[NDSolve::mxsst];
(*Ktemp = Array[0.001+0.001#^2&,13]*)
hSol = h /. NDSolve[{
(*S,G,E,K,D,VR,M*)
Kvar[t_] := Piecewise[{{0.01, t <= 4}, {0.05, t > 4}}],
EvapThickFilm[1, 3, 0.1, Kvar[t], 0.01, 0.1, 0, 160],
h[0, y, t] == h[L, y, t],
h[x, 0, t] == h[x, L, t],
(*h[x,y,0] == 1.1+Cos[x] Sin[2y] *)
h[x, y, 0] ==
1 + (-0.25 Cos[2 \[Pi] x/L] - 0.25 Sin[2 \[Pi] x/L]) Cos[
2 \[Pi] y/L]
},
h,
{x, 0, L},
{y, 0, L},
{t, 0, TMax}
][[1]]
hGrid = InterpolatingFunctionGrid[hSol];
PS: I am sorry but the first cell block doesn't display so well here. And thanks to not having enough "reputation", I can't post images.
The error message occurs when using the NDSolve cell block.
Define the function Kvar outside of a set of equations in NDSolve, like
Off[NDSolve::mxsst];
(*Ktemp=Array[0.001+0.001#^2&,13]*)
Kvar[t_] := Piecewise[{{0.01, t <= 4}, {0.05, t > 4}}];
hSol = ...
and remove it from the list in NDSolve, so that it starts as NDSolve[{(*S,G,E,K,D,VR,M*)EvapThickFilm[..., and it will work. It gives warnings, but those are related to possible singularities in your equation.
Also, your original error indicates that your Kvar was assigned a value of 0.05. So, add Clear[Kvar] before anything else in the second cell.
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.