Force function evaluation on declaration - wolfram-mathematica

I have a function f[x_,y_,z_]:=Limit[g[x+eps,y,z],eps->0]; and I plot f[x,y,z] in the next step. Earlier, I used to evaluate the limit and copy the expression in the definition of f. I tried to make it all in one step. However, the evaluation of the Limit is done only when I try to plot f. As a result, every time I change around the variables and replot, the limit is evaluated all over again (it takes about a min to evaluate, so it becomes annoying). I tried evaluating the limit first, and then doing f[x_,y_,z_]:=%. But that doesn't work either. How do I get the function to evaluate the limit upon declaration?

The function you need is logically called Evaluate and you can use it within the Plot command.
Here is a contrived example:
f[x_, y_, z_] := Limit[Multinomial[x, y, z], x -> 0]
Plot3D[ Evaluate[ f[x, y, z] ], {y, 1, 5}, {z, 1, 5}]
Addressing your follow-up question, perhaps all you seek is something like
ff = f[x, y, z]
Plot3D[ff, {y, 1, 5}, {z, 1, 5}]
or possibly merely
ClearAll[f, x, y, z]
f[x_, y_, z_] = Limit[Multinomial[x, y, z], x -> 0]
Plot3D[f[x, y, z], {y, 1, 5}, {z, 1, 5}]
It would be helpful if you would post a more complete version of your code.

An alternative to Mr Wizard's solution is that you can also put the Evaluate in the function's definition:
f[x_, y_, z_] := Evaluate[Limit[Multinomial[x, y, z], x->0]]
Plot3D[f[x, y, z], {y, 1, 5}, {z, 1, 5}]
You can compare the two versions with the one without an Evaluate by Timing the Plot.

Related

Mathematica: FindFit for NIntegrate of ParametricNDSolve

I`ve seen several answers for quite similar topics with usage of ?NumericQ explained and still can not quite understand what is wrong with my implementation and could my example be evaluated at all the way I want it.
I have solution of differential equation in form of ParametricNDSolve (I believe that exact form of equation is irrelevant):
sol = ParametricNDSolve[{n'[t] == g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2, n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
After that I am trying to construct a function for FindFit or similar procedure, Nintegrating over function n[a,b,c,g,f,y,t] I have got above with some multiplier (I have chosen Log[z] as multiplier for simplicity)
Func[z_, a_, b_, c_, g_, f_] :=
NIntegrate[
Log[z]*(n[a, b, c, g, f, y][t] /. sol), {t, 0, 10}, {y, 0, Log[z]}]
So I have NIntegrate over my function n[params,t] derived from ParametricNDSolve with multiplier introducing new variable (z) wich also present in the limits of integration (in the same form as in multiplier for simplicity of example)
I am able to evaluate the values of my function Func at any point (z) with given values of parameters (a,b,c,g,f): Func(0,1,2,3,4,5) could be evaluated.
But for some reasons I cannot use FindFit like that:
FindFit[data, Func[z, a, b, c, g, f], {a, b, c, g, f}, z]
The error is: NIntegrate::nlim: y = Log[z] is not a valid limit of integration.
I`ve tried a lot of different combinations of ?NumericQ usage and all seems to lead nowhere. Any help would be appreciated!
Thanks in advance and sorry for pure english in the problem explanation.
Here is a way to define your function:
sol = n /.
ParametricNDSolve[{n'[t] ==
g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2,
n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
Func[z_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ, g_?NumericQ,
f_?NumericQ] :=
NIntegrate[Log[z]*sol[a, b, c, g, f, y][t],
{t, 0, 10}, {y, 0, Log[z]}]
test: Func[2, .45, .5, .13, .12, .2] -> 0.106107
I'm not optimistic you will get good results from FindFit with a function with so many parameters and which is so computationally expensive.

Solving two dimensional Heat equation PDE in mathematica

I am trying to solve the following equation in Mathematica but I do not know each time it only returns the equation itself instead of solving it. I tried both Dsolve and NDsolve and it was not helping me. Could anyone help me with the correct syntax?
There is a symmetry boundary condition there and the equation is in cylindrical r and z and depends on time t too.
heat= (1/r)*D[r*T[r, z, t], r] +
D[T[r, z, t], {z, 2}] == (1/(10^-4))*D[T[r, z, t], t]
NDSolve[{heat, T[0.05, z, 0] == 500, D[T[r, z, t], r] == 0},
T, {r, 0.01, 0.05}, {t, 0, 10}, {z, 0, 0.05}]
I did the same with Dsolve and no success.
If this question is not related to here would you guide me where and how to post it before you deactivate it? thank you

How to solve an equation system in Mathematica 9

Got a simple equation but Mathematica just can't get it:
Solve[{Sin[x] == y, x + y == 5}, {x, y}]
Error: this system cannot be solved with the methods available to Solve
Am I using the right function? If not, what should I use?
Mathematica knows a lot, but it surely doesn't know everything about math. When stuffs breakdown, you can try a few different approaches:
First let's graph it:
ContourPlot[{Sin[x] == y, x + y == 5}, {x, -10, 10}, {y, -10, 10}]
It's a line intersecting a sinusoidal wave and it looks likes there is only one solution. The point is close to (5,0) so let's use the Newton method to find the root:
FindRoot[{Sin[x] == y, x + y == 5}, {x, 5}, {y, 0}]
This gives the answer {x -> 5.61756, y -> -0.617555}. You can verify it by replacing x and y in the equation with the values provided in the solution:
{Sin[x] == y, x + y == 5} /. {x -> 5.6175550052727`,y -> -0.6175550052726998`}
That gives {True,True} so the solution is correct. Interestingly, as another commenter pointed out, Wolfram Alpha gives the same solution when you type in this:
solve Sin[x]==y,x+y==5
You can access Wolfram Alpha directly from Mathematica by typing == at the beginning of a new line.

Mathematica: FindRoot for common tangent

I asked this question a little while back that did help in reaching a solution. I've arrived at a somewhat acceptable approach but still not fully where I want it. Suppose there are two functions f1[x] and g1[y] that I want to determine the value of x and y for the common tangent(s). I can at least determine x and y for one of the tangents for example with the following:
f1[x_]:=(5513.12-39931.8x+23307.5x^2+(-32426.6+75662.x-43235.4x^2)Log[(1.-1.33333x)/(1.-1.x)]+x(-10808.9+10808.9x)Log[x/(1.-1.x)])/(-1.+x)
g1[y_]:=(3632.71+3806.87y-51143.6y^2+y(-10808.9+10808.9y)Log[y/(1.-1.y)]+(-10808.9+32426.6y-21617.7y^2)Log[1.-(1.y)/(1.-1.y)])/(-1.+y)
Show[
Plot[f1[x],{x,0,.75},PlotRange->All],
Plot[g1[y],{y,0,.75},PlotRange->All]
]
Chop[FindRoot[
{
(f1[x]-g1[y])/(x-y)==D[f1[x],x]==D[g1[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]
However, you'll notice from the plot that there exists another common tangent at slightly larger values of x and y (say x ~ 4 and y ~ 5). Now, interestingly if I slightly change the above expressions for f1[x] and g1[y] to something like the following:
f2[x_]:=(7968.08-59377.8x+40298.7x^2+(-39909.6+93122.4x-53212.8x^2)Log[(1.-1.33333x)/(1.-1.x)]+x(-13303.2+13303.2x)Log[x/(1.-1.x)])/(-1.+x)
g2[y_]:=(5805.16-27866.2y-21643.y^2+y(-13303.2+13303.2y)Log[y/(1.-1.y)]+(-13303.2+39909.6y-26606.4y^2)Log[1.-(1.y)/(1.-1.y)])/(-1.+y)
Show[
Plot[f2[x],{x,0,.75},PlotRange->All],
Plot[g2[y],{y,0,.75},PlotRange->All]
]
Chop[FindRoot[
{
(f2[x]-g2[y])/(x-y)==D[f2[x],x]==D[g2[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]
And use the same method to determine the common tangent, Mathematica chooses to find the larger values of x and y for the positive sloping tangent.
Finally, my question: is it possible to have Mathematica find both the high and low x and y values for the common tangent and store these values in a similar way that allows me to make a list plot? The functions f and g above are all complex functions of another variable, z, and I am currently using something like the following to plot the tangent points (should be two x and two y) as a function of z.
ex[z_]:=Chop[FindRoot[
{
(f[x,z]-g[y,z])/(x-y)==D[f[x],x]==D[g[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]
ListLinePlot[
Table[{ex[z][[i]],z},{i,1,2},{z,1300,1800,10}]
]
To find estimates for {x, y} that would solve your equations, you could plot them in ContourPlot and look for intersection points. For example
f1[x_]:=(5513.12-39931.8 x+23307.5 x^2+(-32426.6+75662. x-
43235.4 x^2)Log[(1.-1.33333 x)/(1.-1.x)]+
x(-10808.9+10808.9 x) Log[x/(1.-1.x)])/(-1.+x)
g1[y_]:=(3632.71+3806.87 y-51143.6 y^2+y (-10808.9+10808.9y) Log[y/(1.-1.y)]+
(-10808.9+32426.6 y-21617.7 y^2) Log[1.-(1.y)/(1.-1.y)])/(-1.+y)
plot = ContourPlot[{f1'[x] == g1'[y], f1[x] + f1'[x] (y - x) == g1[y]},
{x, 0, 1}, {y, 0, 1}, PlotPoints -> 40]
As you can see there are 2 intersection points in the interval (0,1). You could then read off the points from the graph and use these as starting values for FindRoot:
seeds = {{.6,.4}, {.05, .1}};
sol = FindRoot[{f1'[x] == g1'[y], f1[x] + f1'[x] (y - x) == g1[y]},
{x, #1}, {y, #2}] & ### seeds
To get the pairs of points from sol you can use ReplaceAll:
points = {{x, f1[x]}, {y, g1[y]}} /. sol
(*
==> {{{0.572412, 19969.9}, {0.432651, 4206.74}},
{{0.00840489, -5747.15}, {0.105801, -7386.68}}}
*)
To show that these are the correct points:
Show[Plot[{f1[x], g1[x]}, {x, 0, 1}],
{ParametricPlot[#1 t + (1 - t) #2, {t, -5, 5}, PlotStyle -> {Gray, Dashed}],
Graphics[{PointSize[Medium], Point[{##}]}]} & ### points]
OK, so let's quickly rewrite what you've done so far:
Using your f1 and g1, we have the plot
plot = Plot[{f1[x], g1[x]}, {x, 0, .75}]
and the first shared tangent at
sol1 = Chop[FindRoot[{(f1[x] - g1[y])/(x - y) == D[f1[x], x] == D[g1[y], y]},
{x, 0.0000001}, {y, .00000001}]]
(* {x -> 0.00840489, y -> 0.105801} *)
Define the function
l1[t_] = (1 - t) {x, f1[x]} + t {y, g1[y]} /. sol1
then, you can plot the tangents using
Show[plot, Graphics[Point[{l1[0], l1[1]}]],
ParametricPlot[l1[t], {t, -1, 2}],
PlotRange -> {{-.2, .4}, {-10000, 10000}}]
I briefly note (for my own sake) that the equations you used
(e.g., to generate sol1 above)
come from requiring that the tangent line for f1 at x
tangentially hits g1 at some point y, i.e.,
LogicalExpand[{x, f[x]} + t {1, f'[x]} == {y, g[y]} && f'[x] == g'[y]]
To investigate where the shared tangents lie, you can use a Manipulate:
Manipulate[Show[plot, ParametricPlot[{x, f1[x]} + t {1, f1'[x]}, {t, -1, 1}]],
{x, 0, .75, Appearance -> "Labeled"}]
which produces something like
Using the eyeballed values for x and y, you can get the actual solutions using
sol = Chop[Table[
FindRoot[{(f1[x] - g1[y])/(x - y) == D[f1[x], x] == D[g1[y], y]},
{x, xy[[1]]}, {y, xy[[2]]}], {xy, {{0.001, 0.01}, {0.577, 0.4}}}]]
define the two tangent lines using
l[t_] = (1 - t) {x, f1[x]} + t {y, g1[y]} /. sol
then
Show[plot, Graphics[Point[Flatten[{l[0], l[1]}, 1]]],
ParametricPlot[l[t], {t, -1, 2}, PlotStyle -> Dotted]]
This process could be automated, but I'm not sure how to do it efficiently.

Counting expressions in Mathematica

If I want to count the number of times that ^ occurs in an expression x, that's easy:
Count[x, _Power, {0, Infinity}]
Suppose I want to count only instances of -1 raised to some power. How can I do that?
I had tried
Count[(-1)^n + 2^n, _Power[-1, _], {0, Infinity}]
and even
Count[Plus[Power[-1, n], Power[2, n]], _Power[-1, _], {0, Infinity}]
but both gave 0.
The origin of the question: I'm building a ComplexityFunction that allows certain expressions like Power[-1, anyComplicatedExpressionHere] and Sqrt[5] (relevant to my problem) but heavily penalizes other uses of Power and Sqrt.
You would do Count[x,Power[-1,_], {0, Infinity}]
In[4]:= RandomInteger[{-1, 1}, 10]^RandomChoice[{x, y, z}, 10]
Out[4]= {(-1)^x, (-1)^x, 0^y, 0^z, (-1)^z, 1, 1, 1, (-1)^y, 0^x}
In[5]:= Count[%, (-1)^_, {0, Infinity}]
Out[5]= 4
What is about
Count[expr, Power[-1, _], {0, Infinity}]
P.S. Example in the question is not correct. I think you probably mean
Count[x, _Power, {0, Infinity}]
Probably
Count[x, Power[-1, _], Infinity]
the level specification of Infinity includes all levels 1 through infinity
pattern Power[-1, _] will only match the the instances of Power when the radix is -1

Resources