I have a non-analytical equation. I could solve for different values of parameters but my program is not working at all. At the end i want to plot y vs x
f[x_] := y + Sqrt[3 + x*y - x^20 - y^4]
Table[f[x], {x, 0.1, 0.5, 0.1}]
NSolve[f[x] == 0, y]
f[x_] := y + Sqrt[3 + x*y - x^20 - y^4]
sol = Solve[f[x] == 0, y];
x0 = Table[i, {i, 0.1, 0.5, 0.1}];
subs = N[sol /. x -> #] & /# x0
This creates results from which we can see that the first and second solutions produce complex numbers. Plotting the two real solutions first.
y3 = subs[[All, 3, 1, 2]];
y4 = subs[[All, 4, 1, 2]];
ListLinePlot[{Transpose[{x0, y3}], Transpose[{x0, y4}]}]
Alternatively the plot can be produced from the solutions with
Plot[{sol[[3, 1, 2]], sol[[4, 1, 2]]}, {x, 0.1, 0.5}]
The complex solutions can be plotted like so:
ParametricPlot[{{Re[sol[[1, 1, 2]]], Im[sol[[1, 1, 2]]]},
{Re[sol[[2, 1, 2]]], Im[sol[[2, 1, 2]]]}}, {x, 0, Pi/2}]
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]}
While playing with Fourier Integrals, I've noticed my computations taking an excessively long time to calculate. I just have two sets of a Piecewise function, two functions and two integrals. I wouldn't think Mathematica would need to take so long to compute these. What, in particular, is slowly my computations down so much? How can I improve computation time? Will using some combination of memoization help ( :=, for which I don't quite understand)?
Decreasing the Limit on the integrals helps slightly, but not as much as I'd think.
My code is the following:
MM = 50;
qf = 10;
(*First Set*)
f[t_] = Piecewise[{{1, t <= 0.5}, {0, t > 0.5}}];
A[w_] = qf Sin[w/2]/(Pi w);
B[w_] = qf (1 - Cos[w/2])/(Pi w);
f[x_] = Integrate[A[w] Cos[w x], {x, 0, MM}];
g[x_] = Integrate[B[w] Sin[w x], {x, 0, MM}];
Plot[f[x], {x, 0, 1}]
Plot[g[x], {x, 0, 1}]
Plot[f[x] + g[x], {x, 0, 1}]
(*Second Set*)
ff[t_] = Piecewise[{{1, t <= 0.5}, {0, t > 0.5}}];
AA[w_] = qf (Sin[w] - Sin[w/2])/(Pi w);
BB[w_] = -qf (Cos[w] - Cos[w/2])/(Pi w);
ff[x_] = Integrate[AA[w] Cos[w x], {x, 0, MM}];
gg[x_] = Integrate[BB[w] Sin[w x], {x, 0, MM}];
Plot[ff[x], {x, 0, 1}]
Plot[gg[x], {x, 0, 1}]
Plot[ff[x] + gg[x], {x, 0, 1}]
You have several problems with your code as shown:
You haven't defined w so e.g. f[x_] isn't fully evaluated
you define f[t_] then f[x_] which overwrites the first definition
You're misusing Piecewise. It should be something like pw = Piecewise[{{Sin[x]/x, x < 0}, {1, x == 0}}, -x^2/100 + 1]
I'm very new to Mathematica, so sorry if this has an obvious answer, but:
I'm trying to use NSolve to find the point of intersection between two functions, one of which was made using Interpolation, but it won't give me a solution.
Here is the input:
data = Table[x, {x, 1, 25, 1}];
data2 = Table[x^.5, {x, 1, 25, 1}];
a1 = Interpolation[Transpose[{data, data2}]];
NSolve[a1[z] == 5 - z^.5, z]
And the output:
NSolve[InterpolatingFunction[][z] == 5 - z^0.5, z, Reals]
Thanks for the help!
In[1]:= data = Table[x, {x, 1, 25, 1}];
data2 = Table[x^.5, {x, 1, 25, 1}];
a1 = Interpolation[Transpose[{data, data2}]];
r = z /. FindRoot[a1[z] - (5 - z^.5), {z, 1}];
{r, a1[r], 5 - r^.5}
Out[5]= {6.24994, 2.50001, 2.50001}
I am trying to quickly solve the following problem:
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}]
I can get the answer quickly with this code:
$starttime = AbsoluteTime[]; Quiet[LaunchKernels[]];
DIM = 50;
Print["$Version = ", $Version, " ||| ",
"Number of Kernels : ", Length[Kernels[]]];
Nw = Transpose[Table[f[j], {i, 1}, {j, 5, DIM, 1}]];
nw2 = Nw.Transpose[Nw];
Round[First[AbsoluteTiming[nw3 = ParallelMap[Expand, nw2]; ]]]
intrule = (pol_Plus)?(PolynomialQ[#1, x]&) :>
(Select[pol, !FreeQ[#1, x] & ] /.
x^(n_.) /; n > -1 :> ((-1)^n + 1)/(n + 1)) + 2*(pol /. x -> 0)]);
Round[First[AbsoluteTiming[X1 = ParallelTable[row /. intrule, {row, nw3}]; ]]]
X1
Print["overall time needed in seconds: ", Round[AbsoluteTime[] - $starttime]];
But how can I manage this code if I need to solve the following problem, where a and b are known constants?
X1 = a Integrate[Nw.Transpose[Nw], {x, -1, 0.235}]
+ b Integrate[Nw.Transpose[Nw], {x, 0.235,1}];
Here's a simple function to do definite integrals of polynomials
polyIntegrate[expr_List, {x_, x0_, x1_}] := polyIntegrate[#, {x, x0, x1}]&/#expr
polyIntegrate[expr_, {x_, x0_, x1_}] := Check[Total[#
Table[(x1^(1 + n) - x0^(1 + n))/(1 + n), {n, 0, Length[#] - 1}]
]&[CoefficientList[expr, x]], $Failed, {General::poly}]
On its range of applicability, this is about 100 times faster than using Integrate. This should be fast enough for your problem. If not, then it could be parallelized.
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, 50, 1}]];
a*polyIntegrate[Nw.Transpose[Nw], {x, -1, 0.235}] +
b*polyIntegrate[Nw.Transpose[Nw], {x, 0.235, 1}] // Timing // Short
(* Returns: {7.9405,{{0.0097638 a+0.00293462 b,<<44>>,
-0.0000123978 a+0.0000123978 b},<<44>>,{<<1>>}}} *)
i'd like to have something like this
w[w1_] :=
NDSolve[{y''[x] + y[x] == 2, y[0] == w1, y'[0] == 0}, y, {x, 0, 30}]
this seems like it works better but i think i'm missing smtn
w := NDSolve[{y''[x] + y[x] == 2, y[0] == w1, y'[0] == 0},
y, {x, 0, 30}]
w2 = Table[y[x] /. w, {w1, 0.0, 1.0, 0.5}]
because when i try to make a table, it doesn't work:
Table[Evaluate[y[x] /. w2], {x, 10, 30, 10}]
i get an error:
ReplaceAll::reps: {<<1>>[x]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>
ps: is there a better place to ask questions like that? mathematica doesn't have supported forums and only has mathGroup e-mail list. it would be nice if stackoverflow would have more specific mathematica tags like simplify, ndsolve, plot manipulation
There are a lot of ways to do that. One is:
w[w1_] := NDSolve[{y''[x] + y[x] == 2,
y'[0] == 0}, y[0] == w1,
y[x], {x, 0, 30}];
Table[Table[{w1,x,y[x] /. w[w1]}, {w1, 0., 1.0, 0.5}]/. x -> u, {u, 10, 30, 10}]
Output:
{{{0., 10, {3.67814}}, {0.5, 10, {3.25861}}, {1.,10, {2.83907}}},
{{0., 20, {1.18384}}, {0.5, 20, {1.38788}}, {1.,20, {1.59192}}},
{{0., 30, {1.6915}}, {0.5, 30, {1.76862}}, {1.,30, {1.84575}}}}
I see you already chose an answer, but I want to toss this solution for families of linear equations up. Specifically, this is to model a slight variation on Lotka-Volterra.
(*Put everything in a module to scope x and y correctly.*)
Module[{x, y},
(*Build a function to wrap NDSolve, and pass it
the initial conditions and range.*)
soln[iCond_, tRange_, scenario_] :=
NDSolve[{
x'[t] == -scenario[[1]] x[t] + scenario[[2]] x[t]*y[t],
y'[t] == (scenario[[3]] - scenario[[4]]*y[t]) -
scenario[[5]] x[t]*y[t],
x[0] == iCond[[1]],
y[0] == iCond[[2]]
},
{x[t], y[t]},
{t, tRange[[1]], tRange[[2]]}
];
(*Build a plot generator*)
GeneratePlot[{iCond_, tRange_, scen_,
window_}] :=
(*Find a way to catch errors and perturb iCond*)
ParametricPlot[
Evaluate[{x[t], y[t]} /. soln[iCond, tRange, scen]],
{t, tRange[[1]], tRange[[2]]},
PlotRange -> window,
PlotStyle -> Thin, LabelStyle -> Medium
];
(*Call the plot generator with different starting conditions*)
graph[scenario_, tRange_, window_, points_] :=
{plots = {};
istep = (window[[1, 2]] - window[[1, 1]])/(points[[1]]+1);
jstep = (window[[2, 2]] - window[[2, 1]])/(points[[2]]+1);
Do[Do[
AppendTo[plots, {{i, j}, tRange, scenario, window}]
, {j, window[[2, 1]] + jstep, window[[2, 2]] - jstep, jstep}
], {i, window[[1, 1]] + istep, window[[1, 2]] - istep, istep}];
Map[GeneratePlot, plots]
}
]
]
We can then use Animate (or table, but animate is awesome)
tRange = {0, 4};
window = {{0, 8}, {0, 6}};
points = {5, 5}
Animate[Show[graph[{3, 1, 8, 2, 0.5},
{0, t}, window, points]], {t, 0.01, 5},
AnimationRunning -> False]