I would like to make a 3d plot of a function that takes as a variable a function of another variable.
The whole thing is complicated by the fact that my functions are nested piecewise functions
here is my code:
phi0=Function[u,1.21*10^-6/((u/10^44.25)^1.01 + (u/10^44.25)^2.38)][Lx]
zc=Function[v,Piecewise[{{2.49,v>=10^45.74},{2.49*(v/10^45.74)^0.2,v<10^45.74}}]][Lx]
e=Function[uu,Piecewise[{{(1+uu)^4.62,uu<=zc},{(1+zc)^4.62*((1+uu)/(1+zc))^-1.15,uu>zc}}]][z]
Plot3D[e[z,Lx],{z,0,7},{Lx,10^42,10^47}, PlotRange->Full]
but it is not plotting anything, and I am not sure of what to do
EDIT:
thanks, for the hint, I think I solved it this way. It is not giving me any error, but it is taking a lot of time to evaluate the result even in one single point... do you think it is normal?
phizero[Lx_] := 1.21/10^6/((Lx/10^44.25)^1.01 + (Lx/10^44.25)^2.38)
zc[Lx_] :=
Piecewise[{{2.49, Lx >= 10^45.74}, {2.49*(Lx/10^45.74)^0.2,
Lx < 10^45.74}}]
e[z_, Lx_] :=
Piecewise[{{(1 + z)^4.62,
z <= zc[Lx]}, {(1 + zc[Lx])^4.62*((1 + z)/(1 + zc[Lx]))^-1.15,
z > zc[Lx]}}]
phi[z_, Lx_] := phizero[Lx]*e[z, Lx]
(*D[phi[z,Lx],Lx]:=Lx*phi[z,Lx]*)
p[z_, Lx_] = Integrate[Lx*phi[z, Lx], Lx]
p[4, 10^44]
First, Function works like this:
In[1]:= q = Function[x, x^2];
In[2]:= q[4]
Out[2]= 16
so lose the [var] that you have at the end of each of your Function definitions.
You could also do
q[x_]:= x^2
and skip the use of Function[] if that would be simpler.
Next, you define the function e to accept a single argument, but then you give it two arguments when you use it inside your Plot3D. So you need to figure out what your definition of the function e should be and I can't even guess how to do that.
It is taking a long time because it works hard to symbolically integrate the function. It takes a while just to learn it cant be done. -- use NIntegrate for numerical integration. Here is a stab at it.. notice as a good habit i leave out the floating point values from the expressions until really needed:
constants = {c1 -> 10^45.74, c2 -> 10^44.25, c3 -> 2.49, c4 -> 4.62,
c5 -> 2.38, c6 -> 0.2, c7 -> 1.21/10^6, c8 -> -1.15, c9 -> 1.01}
phizero[Lx_] := c7/((Lx/c2)^c9 + (Lx/c2)^c5)
zc[Lx_] := Piecewise[{{c3, Lx >= c1}, {c3 (Lx/c1)^c6, Lx < c1}}]
e[z_, Lx_] :=
Piecewise[{{(1 + z)^c4,
z <= zc[Lx]}, {(1 + zc[Lx])^c4 ((1 + z)/(1 + zc[Lx]))^c8,
z > zc[Lx]}}]
phi[z_, Lx_] := phizero[Lx] e[z, Lx]
p[z_, L1_, L2_] := NIntegrate[Lx phi[z, Lx] /. constants, {Lx, L1, L2}]
p[4, 10^42, 10^47]
quickly returns:
(* ~7 10^84 *)
Related
I have a problem calculating with significant figures in Wolfram Mathematica.
Let me explain better.
I have
f[a_, b_] = a b Sin[25]
and
f[92.0 , 9.81] =381.421
However, I would first like to approximate the result of the product between a and b to three significant digits and then multiply it by Sin [25]. In short, I would like a function like this
f1[a_, b_] = NumberForm[a b, {3, 0}] Sin[25]
But if I evaluate
f1[92,0 , 9.81]
I get
f1[92,0 , 9.81]= 903.Sin[25]
instead of 381.62.
How should I modify f1[a_, b_] to get f1[92,0 , 9.81]=381.62 ?
You can use Round to round to 3 significant digits in your specific case. Then the result is an integer, so Sin[25] does not convert to a real number (a floating point number). However this can be forced with N.
Also Sin assumes radian input unless the input is specified as degree.
Note use of SetDelayed (:=) for the function definition.
f[a_, b_] := N[Round[a b] Sin[25 Degree]]
f[92.0, 9.81]
381.624
For 3 significant digits on a b in general you can use
f[a_, b_] := N[Round[a b, 10^(-3 + Floor[Log10[Abs[a b]]] + 1)] Sin[25 Degree]]
E.g. rounding a b
a = 1.2345;
b = 5.4321;
N[Round[a b, 10^(-3 + Floor[Log10[Abs[a b]]] + 1)]]
6.71
I hope this hasn't been asked before, if so I apologize.
EDIT: For clarity, the following notation will be used: boldface uppercase for matrices, boldface lowercase for vectors, and italics for scalars.
Suppose x0 is a vector, A and B are matrix functions, and f is a vector function.
I'm looking for the best way to do the following iteration scheme in Mathematica:
A0 = A(x0), B0=B(x0), f0 = f(x0)
x1 = Inverse(A0)(B0.x0 + f0)
A1 = A(x1), B1=B(x1), f1 = f(x1)
x2 = Inverse(A1)(B1.x1 + f1)
...
I know that a for-loop can do the trick, but I'm not quite familiar with Mathematica, and I'm concerned that this is the most efficient way to do it. This is a justified concern as I would like to define a function u(N):=xNand use it in further calculations.
I guess my questions are:
What's the most efficient way to program the scheme?
Is RecurrenceTable a way to go?
EDIT
It was a bit more complicated than I tought. I'm providing more details in order to obtain a more thorough response.
Before doing the recurrence, I'm having problems understanding how to program the functions A, B and f.
Matrices A and B are functions of the time step dt = 1/T and the space step dx = 1/M, where T and M are the number of points in the {0 < x < 1, 0 < t} region. This is also true for vector the function f.
The dependance of A, B and f on x is rather tricky:
A and B are upper and lower triangular matrices (like a tridiagonal matrix; I suppose we can call them multidiagonal), with defined constant values on their diagonals.
Given a point 0 < xs < 1, I need to determine it's representative xn in the mesh (the closest), and then substitute the nth row of A and B with the function v( x) (transposed, of course), and the nth row of f with the function w( x).
Summarizing, A = A(dt, dx, xs, x). The same is true for B and f.
Then I need do the loop mentioned above, to define u( x) = step[T].
Hope I've explained myself.
I'm not sure if it's the best method, but I'd just use plain old memoization. You can represent an individual step as
xstep[x_] := Inverse[A[x]](B[x].x + f[x])
and then
u[0] = x0
u[n_] := u[n] = xstep[u[n-1]]
If you know how many values you need in advance, and it's advantageous to precompute them all for some reason (e.g. you want to open a file, use its contents to calculate xN, and then free the memory), you could use NestList. Instead of the previous two lines, you'd do
xlist = NestList[xstep, x0, 10];
u[n_] := xlist[[n]]
This will break if n > 10, of course (obviously, change 10 to suit your actual requirements).
Of course, it may be worth looking at your specific functions to see if you can make some algebraic simplifications.
I would probably write a function that accepts A0, B0, x0, and f0, and then returns A1, B1, x1, and f1 - say
step[A0_?MatrixQ, B0_?MatrixQ, x0_?VectorQ, f0_?VectorQ] := Module[...]
I would then Nest that function. It's hard to be more precise without more precise information.
Also, if your procedure is numerical, then you certainly don't want to compute Inverse[A0], as this is not a numerically stable operation. Rather, you should write
A0.x1 == B0.x0+f0
and then use a numerically stable solver to find x1. Of course, Mathematica's LinearSolve provides such an algorithm.
So generally, if you have two functions f,g: X -->Y, and if there is some binary operation + defined on Y, then f + g has a canonical definition as the function x --> f(x) + g(x).
What's the best way to implement this in Mathematica?
f[x_] := x^2
g[x_] := 2*x
h = f + g;
h[1]
yields
(f + g)[1]
as an output
of course,
H = Function[z, f[z] + g[z]];
H[1]
Yields '3'.
Consider:
In[1]:= Through[(f + g)[1]]
Out[1]= f[1] + g[1]
To elaborate, you can define h like this:
h = Through[ (f + g)[#] ] &;
If you have a limited number of functions and operands, then UpSet as recommended by yoda is surely syntactically cleaner. However, Through is more general. Without any new definitions involving Times or h, one can easily do:
i = Through[ (h * f * g)[#] ] &
i[7]
43218
Another way of doing what you're trying to do is using UpSetDelayed.
f[x_] := x^2;
g[x_] := 2*x;
f + g ^:= f[#] + g[#] &; (*define upvalues for the operation f+g*)
h[x_] = f + g;
h[z]
Out[1]= 2 z + z^2
Also see this very nice answer by rcollyer (and also the ones by Leonid & Verbeia) for more on UpValues and when to use them
I will throw in a complete code for Gram - Schmidt and an example for function addition etc, since I happened to have that code written about 4 years ago. Did not test extensively though. I did not change a single line of it now, so a disclaimer (I was a lot worse at mma at the time). That said, here is a Gram - Schmidt procedure implementation, which is a slightly generalized version of the code I discussed here:
oneStepOrtogonalizeGen[vec_, {}, _, _, _] := vec;
oneStepOrtogonalizeGen[vec_, vecmat_List, dotF_, plusF_, timesF_] :=
Fold[plusF[#1, timesF[-dotF[vec, #2]/dotF[#2, #2], #2]] &, vec, vecmat];
GSOrthogonalizeGen[startvecs_List, dotF_, plusF_, timesF_] :=
Fold[Append[#1,oneStepOrtogonalizeGen[#2, #1, dotF, plusF, timesF]] &, {}, startvecs];
normalizeGen[vec_, dotF_, timesF_] := timesF[1/Sqrt[dotF[vec, vec]], vec];
GSOrthoNormalizeGen[startvecs_List, dotF_, plusF_, timesF_] :=
Map[normalizeGen[#, dotF, timesF] &, GSOrthogonalizeGen[startvecs, dotF, plusF, timesF]];
The functions above are parametrized by 3 functions, realizing addition, multiplication by a number, and the dot product in a given vector space. The example to illustrate will be to find Hermite polynomials by orthonormalizing monomials. These are possible implementations for the 3 functions we need:
hermiteDot[f_Function, g_Function] :=
Module[{x}, Integrate[f[x]*g[x]*Exp[-x^2], {x, -Infinity, Infinity}]];
SetAttributes[functionPlus, {Flat, Orderless, OneIdentity}];
functionPlus[f__Function] := With[{expr = Plus ## Through[{f}[#]]}, expr &];
SetAttributes[functionTimes, {Flat, Orderless, OneIdentity}];
functionTimes[a___, f_Function] /; FreeQ[{a}, # | Function] :=
With[{expr = Times[a, f[#]]}, expr &];
These functions may be a bit naive, but they will illustrate the idea (and yes, I also used Through). Here are some examples to illustrate their use:
In[114]:= hermiteDot[#^2 &, #^4 &]
Out[114]= (15 Sqrt[\[Pi]])/8
In[107]:= functionPlus[# &, #^2 &, Sin[#] &]
Out[107]= Sin[#1] + #1 + #1^2 &
In[111]:= functionTimes[z, #^2 &, x, 5]
Out[111]= 5 x z #1^2 &
Now, the main test:
In[115]:=
results =
GSOrthoNormalizeGen[{1 &, # &, #^2 &, #^3 &, #^4 &}, hermiteDot,
functionPlus, functionTimes]
Out[115]= {1/\[Pi]^(1/4) &, (Sqrt[2] #1)/\[Pi]^(1/4) &, (
Sqrt[2] (-(1/2) + #1^2))/\[Pi]^(1/4) &, (2 (-((3 #1)/2) + #1^3))/(
Sqrt[3] \[Pi]^(1/4)) &, (Sqrt[2/3] (-(3/4) + #1^4 -
3 (-(1/2) + #1^2)))/\[Pi]^(1/4) &}
These are indeed the properly normalized Hermite polynomials, as is easy to verify. The normalization of built-in HermiteH is different. Our results are normalized as one would normalize the wave functions of a harmonic oscillator, say. It is trivial to obtain a list of polynomials as expressions depending on a variable, say x:
In[116]:= Through[results[x]]
Out[116]= {1/\[Pi]^(1/4),(Sqrt[2] x)/\[Pi]^(1/4),(Sqrt[2] (-(1/2)+x^2))/\[Pi]^(1/4),
(2 (-((3 x)/2)+x^3))/(Sqrt[3] \[Pi]^(1/4)),(Sqrt[2/3] (-(3/4)+x^4-3 (-(1/2)+x^2)))/\[Pi]^(1/4)}
I would suggest defining an operator other than the built-in Plus for this purpose. There are a number of operators provided by Mathematica that are reserved for user definitions in cases such as this. One such operator is CirclePlus which has no pre-defined meaning but which has a nice compact representation (at least, it is compact in a notebook -- not so compact on a StackOverflow web page). You could define CirclePlus to perform function addition thus:
(x_ \[CirclePlus] y_)[args___] := x[args] + y[args]
With this definition in place, you can now perform function addition:
h = f \[CirclePlus] g;
h[x]
(* Out[3]= f[x]+g[x] *)
If one likes to live on the edge, the same technique can be used with the built-in Plus operator provided it is unprotected first:
Unprotect[Plus];
(x_ + y_)[args___] := x[args] + y[args]
Protect[Plus];
h = f + g;
h[x]
(* Out[7]= f[x]+g[x] *)
I would generally advise against altering the behaviour of built-in functions -- especially one as fundamental as Plus. The reason is that there is no guarantee that user-added definitions to Plus will be respected by other built-in or kernel functions. In some circumstances calls to Plus are optimized, and those optimizations might be not take the user definitions into account. However, this consideration may not affect any particular application so the option is still a valid, if risky, design choice.
Related A problem in Mathematica 8 with function declaration
Clear["Global`*"]
model = 4/Sqrt[3] - a1/(x + b1) - a2/(x + b2)^2 - a3/(x + b3)^4;
fit = {a1 -> 0.27, a2 -> 0.335, a3 -> -0.347, b1 -> 4.29, b2 -> 0.435,
b3 -> 0.712};
functionB1[x_] = model /. fit;
functionB2[x_] := model /. fit;
The evaluation difference between functionB1 and functionB2 can be revealed by Trace command in mma, as below:
functionB1[Sqrt[0.2]] // Trace
functionB2[Sqrt[0.2]] // Trace
I have no question about functionB1. what puzzles me is that because functionB2[Sqrt[0.2]] doesn't even gives a numeric result but gives a function of x 4/Sqrt[3] - 0.335/(0.435 + x)^2 + 0.347/(0.712 + x)^4 - 0.27/(
4.29 + x), and then how its plot Plot[functionB2[Sqrt[x]], {x, 0, 1}] is possible?
I mean when you run Plot[functionB2[Sqrt[x]], {x, 0, 1}], what happens inside mma is:
x takes a number, say, 0.2, then 0.2 is finally passed to functionB2, but functionB2 gives a function, not a number. Then how is the following figure generated?
And its trace result ( Plot[functionB2[Sqrt[x]], {x, 0, 1}] // Trace ) seems very unreadable. I wonder the clear plotting process of functionB2. Can anybody show it?
thanks~ :)
SetDelayed acts as a scoping construction. Arguments are localized if necessary. Any variables that explicitly match the arguments are bound within this scope, others are not.
In[78]:= a[x_] := x^2 + b
b = x^4;
(* the first x^2 is explicitly present and bound to the argument.
The x in x^4 present via b is not bound *)
In[80]:= a[x]
Out[80]= x^2 + x^4 (* this is what you would expect *)
In[81]:= a[y]
Out[81]= x^4 + y^2 (* surprise *)
In[82]:= a[1]
Out[82]= 1 + x^4 (* surprise *)
So, what you could do is one of two things:
Use Evaluate: functionB2[x_] := Evaluate[model /. fit];
Make dependence of model on x explicit:
In[68]:= model2[x_] =
4/Sqrt[3] - a1/(x + b1) - a2/(x + b2)^2 - a3/(x + b3)^4;
In[69]:= functionB3[x_] := model2[x] /. fit;
In[85]:= functionB3[Sqrt[0.2]]
Out[85]= 2.01415
Edit because of question update
Because of your definition of functionB2 any argument value yields the same result, as explained above:
In[93]:= functionB2[1]
Out[93]= 4/Sqrt[3] - 0.335/(0.435 + x)^2 + 0.347/(0.712 +
x)^4 - 0.27/(4.29 + x)
In[94]:= functionB2["Even a string yields the same ouput"]
Out[94]= 4/Sqrt[3] - 0.335/(0.435 + x)^2 + 0.347/(0.712 +
x)^4 - 0.27/(4.29 + x)
However, this expression contains x's and therefore it can get a numerical value if we provide a numerical value for x:
In[95]:= functionB2["Even a string yields the same ouput"] /. x -> 1
Out[95]= 2.13607
Well, this basically what Plot does too. This is why you still get a plot.
The definition:
functionB2[x_] := model /. fit
is an instruction to Mathematica to replace all future occurrences of an expression that looks like functionB2[x_] with the result of substituting the value of the argument for every occurrence of x in the expression model /. fit. But there are no occurrences of x in model /. fit: the only symbols in that expression are model and fit (and, technically, ReplaceAll). Therefore, the definition returns a fixed result, model /. fit, irrespective of the argument. Indeed, the definition could just simply be:
functionB2a[] := model /. fit
If you plot functionB2a[], you will get the same result as if you plotted functionB2[anything]. Why? Because Plot will evaluate that expression while varying the symbol x over the plot range. It so happens that model /. fit evaluates to an expression involving that symbol, so you get the exhibited plot.
Now consider functionB1:
functionB1[x_] = model /. fit
It too says to replace all occurrences of x on the right-hand side -- but this time the right-hand side is evaluated before the definition is established. The result of evaluating model /. fit is an expression that does contain the symbol x, so now the definition is sensitive to the passed argument value. The net result is as if the function were defined thus:
functionB1a[x_] := 4/Sqrt[3]-0.335/(0.435+x)^2+0.347/(0.712+x)^4-0.27/(4.29+x)
So, if you plot functionB1[Sqrt[x]], the Plot command will see the expression:
4/Sqrt[3]-0.335/(0.435 +Sqrt[x])^2+0.347/(0.712 +Sqrt[x])^4-0.27/(4.29 +Sqrt[x])
Formal Symbols
When establishing definitions using SetDelayed, the name of the formal argument (x in this case) is independent of any occurrences of the same symbol outside of the definition. Such definitions can use any other symbol, and still generate the same result. On the other hand, definitions established using Set (such as functionB1) rely on the result of evaluating the right-hand side containing the same symbol as the formal argument. This can be a source of subtle bugs as one must take care not use symbols that accidentally have pre-existing down-values. The use of formal symbols (described in Letters and Letter-like Forms) for argument names can help manage this problem.
You can understand what is going on by trying:
Table[functionB2[Sqrt[y]],{y,0.5,.5,.5}]
Table[functionB2[Sqrt[x]],{x,0.5,.5,.5}]
(*
{4/Sqrt[3] - 0.335/(0.435+ x)^2 + 0.347/(0.712+ x)^4 - 0.27/(4.29+ x)}
{2.03065}
*)
What is getting replaced is the x inside the definition of functionB2, not a formal argument.
Edit
The plot you are getting is not what you want. The Sqrt[x] is disregarded in functionB2[...] and the implicit x is replaced, as you can see here:
I have some expressions in Mathematica that are defined in terms of other expressions. I want to take some functions of the larger expression and then get the result in terms of the subexpressions. Example:
In[78]:= e1 = x + y;
e2 = 2^e1;
In[80]:= D[e2, x]
Out[80]= 2^(x + y) Log[2]
I want the output to instead be 2^e1 Log[2]. I am currently using ReplaceAll as follows, but this is cumbersome in my actual application with about 20 subexpressions.
In[81]:= D[e2, x] /. e1 -> E1
Out[81]= 2^E1 Log[2]
Difficult to obtain and keep that form, if you set e1 to be x+y. So if you do not really need that, could instead work with replacement rules.
rul = {e1->x+y, e2->2^e1};
revrul = {x+y->e1};
InputForm[D[e2//.rul, x] /. revrul]
Out[5]//InputForm= 2^e1*Log[2]
Daniel Lichtblau
Wolfram Research
Your answer appears to be specific due to the simple form of your e1 and e2. One possibility is to define e2 as a function in terms of e1, without specifying what e1 is:
In[8]:= Clear[e1, e2];
e2[x_] := 2^e1[x]
Then
In[10]:= D[e2[x], x]
Out[10]= 2^e1[x] Log[2] Derivative[1][e1][x]
which is a generally correct answer. As soon as you want it to compute, you can provide specific definition for e1. You can also do this inside Block, so that you don't introduce global definitions:
In[11]:=
Block[{e1},
e1[x_] := x + y;
D[e2[x], x]]
Out[11]= 2^(x + y) Log[2]
I suppose this approach can scale to a larger number of sub-expressions.
HTH