Related
I have a simple Mathematica code below where I first introduce a scalar function ϕ = ϕ[x,y,z] and then calculate the gradient of ϕ. Now, I would like to evaluate the Gradient at point P by substituting in proper values for x, y, z. Please assist me with last step with plugging values into x and y into gradient. See code Below:
ϕ = y^2 + z^2 - 4;
varlist = {x, y, z}
Delϕ = Table[D[ϕ, varlist[[i]]], {j, 1, 1}, {i, 1, 3}]
Delϕ // MatrixForm
P = {2, 1, Sqrt (3)}
Thanks
Assuming you meant y^2 + z^2 - 4 x
φ = y^2 + z^2 - 4 x;
varlist = {x, y, z};
g = D[φ, #] & /# varlist
{-4, 2 y, 2 z}
p = {2, 1, Sqrt[3]};
grad = g /. Thread[varlist -> p]
{-4, 2, 2 Sqrt[3]}
another approach is to make your derivative a function:
\[Phi] = y^2 + z^2 - 4 x;
varlist = {x, y, z};
Del\[Phi][{x_, y_, z_}] = Table[D[\[Phi], varlist[[i]]], {i, 1, 3}];
then you can simply do this:
P = {2, 1, Sqrt[3]};
Del\[Phi][P]
{-4, 2, 2 Sqrt[3]}
Can I plot and deal with implicit functions in Mathematica?
for example :-
x^3 + y^3 = 6xy
Can I plot a function like this?
ContourPlot[x^3 + y^3 == 6*x*y, {x, -2.7, 5.7}, {y, -7.5, 5}]
Two comments:
Note the double equals sign and the multiplication symbols.
You can find this exact input via the WolframAlpha interface. This interface is more forgiving and accepts your input almost exactly - although, I did need to specify that I wanted some type of plot.
Yes, using ContourPlot.
And it's even possible to plot the text x^3 + y^3 = 6xy along its own curve, by replacing the Line primitive with several Text primitives:
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black, PlotPoints -> 7, MaxRecursion -> 1, ImageSize -> 500] /.
{
Line[s_] :>
Map[
Text[Style["x^3+y^3 = 6xy", 16, Hue[RandomReal[]]], #, {0, 0}, {1, 1}] &,
s]
}
Or you can animate the equation along the curve, like so:
res = Table[ Normal[
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black,
ImageSize -> 600]] /.
{Line[s_] :> {Line[s],
Text[Style["x^3+y^3 = 6xy", 16, Red], s[[k]], {0, 0},
s[[k + 1]] - s[[k]]]}},
{k, 1, 448, 3}];
ListAnimate[res]
I'm guessing this is what you need:
http://reference.wolfram.com/mathematica/Compatibility/tutorial/Graphics/ImplicitPlot.html
ContourPlot[x^3 + y^3 == 6 x*y, {x, -10, 10}, {y, -10, 10}]
I am looking to see how a function that computes the Hessian of a log-likelihood can be compiled, so that it can be efficiently used with different sets of parameters.
Here is an example.
Suppose we have a function that computes the log-likelihood of a logit model, where y is vector and x is a matrix. beta is a vector of parameters.
pLike[y_, x_, beta_] :=
Module[
{xbeta, logDen},
xbeta = x.beta;
logDen = Log[1.0 + Exp[xbeta]];
Total[y*xbeta - logDen]
]
Given the following data, we can use it as follows
In[1]:= beta = {0.5, -1.0, 1.0};
In[2]:= xmat =
Table[Flatten[{1,
RandomVariate[NormalDistribution[0.0, 1.0], {2}]}], {500}];
In[3]:= xbeta = xmat.beta;
In[4]:= prob = Exp[xbeta]/(1.0 + Exp[xbeta]);
In[5]:= y = Map[RandomVariate[BernoulliDistribution[#]] &, prob] ;
In[6]:= Tally[y]
Out[6]= {{1, 313}, {0, 187}}
In[9]:= pLike[y, xmat, beta]
Out[9]= -272.721
We can write its hessian as follows
hessian[y_, x_, z_] :=
Module[{},
D[pLike[y, x, z], {z, 2}]
]
In[10]:= z = {z1, z2, z3}
Out[10]= {z1, z2, z3}
In[11]:= AbsoluteTiming[hess = hessian[y, xmat, z];]
Out[11]= {0.1248040, Null}
In[12]:= AbsoluteTiming[
Table[hess /. {z1 -> 0.0, z2 -> -0.5, z3 -> 0.8}, {100}];]
Out[12]= {14.3524600, Null}
For efficiency reasons, I can compile the original likelihood function as follows
pLikeC = Compile[{{y, _Real, 1}, {x, _Real, 2}, {beta, _Real, 1}},
Module[
{xbeta, logDen},
xbeta = x.beta;
logDen = Log[1.0 + Exp[xbeta]];
Total[y*xbeta - logDen]
],
CompilationTarget -> "C", Parallelization -> True,
RuntimeAttributes -> {Listable}
];
which yields the same answer as pLike
In[10]:= pLikeC[y, xmat, beta]
Out[10]= -272.721
I am looking for an easy way to obtain similarly, a compiled version of the hessian function, given my interest in evaluating it many times.
Leonid already beat me, but I'll post my line of thought anyway just for laughs.
The main problem here is that compilation works for numerical functions whereas D needs symbolics. So the trick would be to first define the pLike function with the same amount of variables as needed for the particular size of matrices you intend to use, e.g,
pLike[{y1, y2}, {{x1, x2, x3}, {x12, x22, x32}}, {z1, z2, z3}]
The Hessian:
D[pLike[{y1, y2}, {{x1, x2, x3}, {x12, x22, x32}}, {z1, z2, z3}], {{z1, z2, z3}, 2}]
This function should be compilable as it depends on numerical quantities only.
To generalize for various vectors one could build something like this:
Block[{ny = 2, nx = 3, z1, z2, z3},
hessian[
Table[ToExpression["y" <> ToString[i] <> "_"], {i, ny}],
Table[ToExpression["xr" <> ToString[i] <> "c" <> ToString[j] <> "_"],
{i, ny}, {j, nx}], {z1_, z2_, z3_}
] =
D[
pLike[
Table[ToExpression["y" <> ToString[i]], {i, ny}],
Table[ToExpression["xr" <> ToString[i] <> "c" <> ToString[j]],
{i, ny}, {j, nx}], {z1, z2, z3}
],
{{z1, z2, z3}, 2}
]
]
And this can of course be easily generalized for variable nx and ny.
And now for the Compile part. It's an ugly piece of code, consisting of the above and a compile and made suitable for variable y size. I like ruebenko's code more than mine.
ClearAll[hessianCompiled];
Block[{z1, z2, z3},
hessianCompiled[yd_] :=
(hessian[
Table[ToExpression["y" <> ToString[i] <> "_"], {i, yd}],
Table[ToExpression["xr" <> ToString[i]<>"c"<>ToString[j] <>"_"],{i,yd},{j,3}],
{z1_, z2_, z3_}
] =
D[
pLike[
Table[ToExpression["y" <> ToString[i]], {i, yd}],
Table[ToExpression["xr" <> ToString[i] <> "c" <> ToString[j]], {i,yd},{j,3}],
{z1, z2, z3}
], {{z1, z2, z3}, 2}
];
Compile[{{y, _Real, 1}, {x, _Real, 2}, {z, _Real, 1}},
hessian[Table[y[[i]], {i, yd}], Table[x[[i, j]], {i, yd}, {j, 3}],
Table[z[[i]], {i, 3}]]]// Evaluate] // Quiet
)
]
hessianCompiled[500][y, xmat, beta] // Timing
{1.497, {{-90.19295669, -15.80180276, 6.448357845},
{-15.80180276, -80.41058154, -26.33982586},
{6.448357845, -26.33982586, -72.92978931}}}
ruebenko's version (including my edits):
(cf = mkCHessian[500, 3]; cf[y, xmat, beta]) // Timing
{1.029, {{-90.19295669, -15.80180276, 6.448357845},
{-15.80180276, -80.41058154, -26.33982586},
{6.448357845, -26.33982586, -72.92978931}}}
Note that both tests include compilation time. Running the calculation on its own:
h = hessianCompiled[500];
Do[h[y, xmat, beta], {100}]; // Timing
Do[cf[y, xmat, beta], {100}]; // Timing
(* timing for 100 hessians:
==> {0.063, Null}
==> {0.062, Null}
*)
Here is an idea based on the previous post(s): We construct the input to Compile symbolically.
mkCHessian[{y_, ys_Integer}, {x_, xs_Integer}, {beta_, bs_Integer}] :=
With[{
args = MapThread[{#1, _Real, #2} &, {{y, x, beta}, {1, 2, 1}}],
yi = Quiet[Part[y, #] & /# Range[ys]],
xi = Quiet[Table[Part[x, i, j], {i, xs}, {j, xs}]],
betai = Quiet[Part[beta, #] & /# Range[bs]]
},
Print[args];
Print[yi];
Print[xi];
Print[betai];
Compile[Evaluate[args],
Evaluate[D[pLike[yi, xi, betai], {betai, 2}]]]
]
And then generate the compiled function.
cf = mkCHessian[{y, 3}, {x, 3}, {beta, 3}];
You then call that compiled function
cf[y, xmat, beta]
Please verify that I did not make a mistake; in de Vries's post y is of length 2. Mine is length 3. I am sure what is correct. And of course, the Print are for illustration...
Update
A version with slightly improved dimension handling and with variables localized:
ClearAll[mkCHessian];
mkCHessian[ys_Integer, bs_Integer] :=
Module[
{beta, x, y, args, xi, yi, betai},
args = MapThread[{#1, _Real, #2} &, {{y, x, beta}, {1, 2, 1}}];
yi = Quiet[Part[y, #] & /# Range[ys]];
xi = Quiet[Table[Part[x, i, j], {i, ys}, {j, bs}]];
betai = Quiet[Part[beta, #] & /# Range[bs]];
Compile[Evaluate[args], Evaluate[D[pLike[yi, xi, betai], {betai, 2}]]]
]
Now, with asim's definitions in In[1] to In[5]:
cf = mkCHessian[500, 3];
cf[y, xmat, beta]
(* ==> {{-8.852446923, -1.003365612, 1.66653381},
{-1.003365612, -5.799363241, -1.277665283},
{1.66653381, -1.277665283, -7.676551252}} *)
Since y is a random vector results will vary.
Somebody have idea how to use all cores for calculating integration? I need to use parallelize or parallel table but how?
f[r_] := Sum[(((-1)^n*(2*r - 2*n - 7)!!)/(2^n*n!*(r - 2*n - 1)!))*
x^(r - 2*n - 1), {n, 0, r/2}];
Nw := Transpose[Table[f[j], {i, 1}, {j, 5, 200, 1}]];
X1 = Integrate[Nw . Transpose[Nw], {x, -1, 1}];
Y1 = Integrate[D[Nw, {x, 2}] . Transpose[D[Nw, {x, 2}]], {x, -1, 1}];
X1//MatrixForm
Y1//MatrixForm
I changed the integration of a list into a list of integrations so that I can use ParallelTable:
X1par=ParallelTable[Integrate[i, {x, -1, 1}], {i, Nw.Transpose[Nw]}];
X1par==X1
(* ===> True *)
Y1par = ParallelTable[Integrate[i,{x,-1,1}],{i,D[Nw,{x,2}].Transpose[D[Nw,{x,2}]]}]
Y1 == Y1par
(* ===> True *)
In my timings, with {j, 5, 30, 1} instead of {j, 5, 200, 1} to restrict the time used somewhat, this is about 3.4 times faster on my quod-core. But it can be done even faster with:
X2par = Parallelize[Integrate[#, {x, -1, 1}] & /# (Nw.Transpose[Nw])]
X2par == X1par == X1
(* ===> True *)
This is about 6.8 times faster, a factor of 2.3 of which is due to Parallelize.
Timing and AbsoluteTiming are not very trustworthy when parallel execution is concerned. I used AbsoluteTime before and after each line and took the difference.
EDIT
We shouldn't forget ParallelMap:
At the coarsest list level (1):
ParallelMap[Integrate[#, {x, -1, 1}] &, Nw.Transpose[Nw], {1}]
At the deepest list level (most fine-grained parallelization):
ParallelMap[Integrate[#, {x, -1, 1}] &, Nw.Transpose[Nw], {2}]
If one helps Integrate a bit by expanding the matrix elements first,
things are doable with a little bit of effort.
On a quad-core laptop with Windows and Mathematica 8.0.4 the following code below runs
for the asked DIM=200 in about 13 minutes,
for DIM=50 the code runs in 6 second.
$starttime = AbsoluteTime[]; Quiet[LaunchKernels[]];
DIM = 200;
Print["$Version = ", $Version, " ||| ", "Number of Kernels : ", Length[Kernels[]]];
f[r_] := f[r] = Sum[(((-1)^n*(-(2*n) + 2*r - 7)!!)*x^(-(2*n) + r - 1))/(2^n*n!*(-(2*n) + r - 1)!), {n, 0, r/2}];
Nw = Transpose[Table[f[j], {i, 1}, {j, 5, DIM, 1}]];
nw2 = Nw . Transpose[Nw];
Print["Seconds for expanding Nw.Transpose[Nm] ", Round[First[AbsoluteTiming[nw3 = ParallelMap[Expand, nw2]; ]]]];
Print["do the integral once: ", Integrate[x^n, {x, -1, 1}, Assumptions -> n > -1]];
Print["the integration can be written as a simple rule: ", intrule = (pol_Plus)?(PolynomialQ[#1, x] & ) :>
(Select[pol, !FreeQ[#1, x] & ] /. x^(n_.) /; n > -1 :> ((-1)^n + 1)/(n + 1)) + 2*(pol /. x -> 0)];
Print["Seconds for integrating Nw.Transpose[Nw] : ", Round[First[AbsoluteTiming[X1 = ParallelTable[row /. intrule, {row, nw3}]; ]]]];
Print["expanding: ", Round[First[AbsoluteTiming[preY1 = ParallelMap[Expand, D[Nw, {x, 2}] . Transpose[D[Nw, {x, 2}]]]; ]]]];
Print["Seconds for integrating : ", Round[First[AbsoluteTiming[Y1 = ParallelTable[py /. intrule, {py, preY1}]; ]]]];
Print["X1 = ", (Shallow[#1, {4, 4}] & )[X1]];
Print["Y1 = ", (Shallow[#1, {4, 4}] & )[Y1]];
Print["seq Y1 : ", Simplify[FindSequenceFunction[Diagonal[Y1], n]]];
Print["seq X1 0 : ",Simplify[FindSequenceFunction[Diagonal[X1, 0], n]]];
Print["seq X1 2: ",Simplify[FindSequenceFunction[Diagonal[X1, 2], n]]];
Print["seq X1 4: ",Simplify[FindSequenceFunction[Diagonal[X1, 4], n]]];
Print["overall time needed in seconds: ", Round[AbsoluteTime[] - $starttime]];
I am attempting to solve the linear biharmonic equation in mathematica using DSolve. I think this issue is not just limited to the biharmonic equation but MATHEMATICA just spits out the equation when I attempt to solve it.
I've tried solving other partial differential equations and there was no trouble.
The biharmonic equation is just:
Laplacian^2[f]=0
Here is my equation:
DSolve[
D[f[x, y], {x, 4}] + 2 D[D[f[x, y], {x, 2}, {y, 2}]] +
D[f[x, y], {y, 4}] == 0,
f,
{x, y}]
The solution is spit out as
DSolve[(f^(0,4))[x,y]+2 (f^(2,2))[x,y]+(f^(4,0))[x,y]==0,f,{x,y}]
That is obviously not the solution. What gives? What am I missing? I've solved other PDEs without boundary conditions.
How about try it in polar coordinates? If f(r, \[Theta]) is symmetric with respect to azimuth \[Theta], the biharmonic equation reduces to something Mathematca can solve symbolically (c.f. http://mathworld.wolfram.com/BiharmonicEquation.html):
In[22]:= eq = D[r D[D[r D[f[r],r],r]/r,r],r]/r;
eq//FullSimplify//TraditionalForm
Out[23]//TraditionalForm= f^(4)(r) + (2 r^2 f^(3)(r) - r f''(r)
+ f'(r))/r^3
In[24]:= DSolve[eq==0,f,r]
Out[24]= {{f -> Function[{r},
1/2 r^2 C[2] - 1/4 r^2 C[3] + C[4] + C[1] Log[r]
+ 1/2 r^2 C[3] Log[r]
]}}
In[25]:= ReplaceAll[
1/2 r^2 C[2]-1/4 r^2 C[3]+C[4]+C[1] Log[r]+1/2 r^2 C[3] Log[r],
r->Sqrt[x^2+y^2]
]
Out[25]= 1/2 (x^2+y^2) C[2]-1/4 (x^2+y^2) C[3]+C[4]+C[1] Log[Sqrt[x^2+y^2]]+
1/2 (x^2+y^2) C[3] Log[Sqrt[x^2+y^2]]
DSolve[D[f[x, y], {x, 4}] + 2 D[f[x, y], {x, 2}, {y, 2}] +
D[f[x, y], {y, 4}] == 0, f, {x, y}]
This ought to be the actual syntax