Related
I'm trying to plot b against a with the following equation
2 *r* (sin[b]^2) * cos[b] * sin[a + b] == sin[a + 2*b]*((sin[a]^2) + r*(sin[b]^2))
with r at >= 0 and let's say <1000
Solve[2 cos[b] sin[b]^2 sin[a + b] == (sin[a]^2 + sin[b]^2) sin[a + 2 b], b]
However this does give me the error
Solve::nsmet: This system cannot be solved with the methods available to Solve.
How would I be able to solve this equation?
Is this what you are trying to obtain?
Edit
sol = FullSimplify#Solve[
2 r Sin[b]^2 Cos[b] Sin[a + b] == Sin[a + 2 b] (Sin[a]^2 + r Sin[b]^2), b];
Show[Table[Plot[b /. sol[[4]], {a, 3.3, 4.7}],
{r, {0, 0.1, 0.25, 0.5, 1, 2}}],
Frame -> True, Axes -> None,
PlotRange -> {Automatic, {0, Automatic}}]
Hello and thanks in advance,
I came upon an issue trying to plot a piecewise function in Mathematica. When entered directly into the Plot function, the piecewise did NOT plot. However, when I defined the piecewise as a variable, it did plot. Why is this issue occurring and can I still join my plot? (I would like to join it by setting exclusions to none)
The following is my code: (I define a Maxwell strain function and am trying to model the plastic deformation of a polymer over multiple stress cycles)
z = 2*10^10;
h = 10^12;
MaxwellStrain[s_, t_] := s/z + (s*t)/h;
stress = {0, 10^7, -10^7, 5*10^6, 10^7, -5*10^6};
time = {0, 100, 200, 300, 400, 500};
strainList = Join[{0}, Table[MaxwellStrain[stress[[i + 1]], t - time[[i]]], {i, 1, 5}]];
Plot[
Piecewise[
Table[{
Total[strainList[[1 ;; i + 1]]], time[[i]] < t < time[[i + 1]]},
{i, 1, 5}
],
Exclusions -> none]
,
{t, 0, 500}
]
x = Piecewise[
Table[{
Total[strainList[[1 ;; i + 1]]], time[[i]] < t < time[[i + 1]]},
{i, 1, 5}
],
Exclusions -> none]
Plot[x, {t, 0, 500}]
The following is my output: (first plot doesn't show, the second does)
output:
Thank you for the help,
SV
Suppose this code in Mathematica:
w[w1_] := NDSolve[{y''[x] + y[x] == 2, y'[0] == 0, y[0] == w1},y[x], {x, 0, 30}];
Manipulate[Plot[Evaluate[{y[x], y'[x]} /. w[w1]], {x, 0, 30}], {w1, -2, 3}]
The code works this way: A slidebar (in Manipulate) controls one initial condition (value of y[0]) of differential equation saved in variable w and when it is changed, the solution is plotted. This works fine, but I have a problem with plotting the first derivative of the solution (y'[x]). Instead of a function graph there is just simply blank space and nothing is plotted, even I checked it in Mathematica help, where the example code
s = NDSolve[{y''[x] + Sin[y[x]] y[x] == 0, y[0] == 1, y'[0] == 0}, y, {x, 0, 30}]
Plot[Evaluate[{y[x], y'[x], y''[x]} /. s], {x, 0, 30},PlotStyle -> Automatic]
works. Does anybody know where's the problem?
I found the problem, it is just in NDSolve it is needed to write
w[w1_] := NDSolve[{y''[x] + y[x] == 2, y'[0] == 0, y[0] == w1},y, {x, 0, 30}]
y instead of y[x] and everything works.
I programmed a Euler function but misread the instructions, so now I have to make a new one, but I can't figure it out.
I have made the following automatic Euler function.
f[x_, y_] := -x y^2;
x0 = 0;
y0 = 2;
xend = 2;
steps = 20;
h = (xend - x0)/steps // N;
x = x0;
y = y0;
eulerlist = {{x, y}};
For[i = 1, i <= steps, y = f[x, y]*h + y;
x = x + h;
eulerlist = Append[eulerlist, {x, y}];
i++
]
Print[eulerlist]
But it just generates the list I have specified.
I would like to have a Euler function which is able to generate this form:
Euler[y, 2, -x y^2, {x, 0, 2}, 20]
I don't seem to get any further.
It is not clear what you are asking, but if what you want is to be able to input
Euler[y, 2, -x y^2, {x, 0, 2}, 20]
and get
{{0,2},{0.1,2.},{0.2,1.96},{0.3,1.88317},{0.4,1.77678},{0.5,1.6505},{0.6,1.51429},{0.7,1.37671},{0.8,1.24404},{0.9,1.12023},{1.,1.00728},{1.1,0.905822},{1.2,0.815565},{1.3,0.735748},{1.4,0.665376},{1.5,0.603394},{1.6,0.548781},{1.7,0.500596},{1.8,0.457994},{1.9,0.420238},{2.,0.386684}}
Then you need to write a function definition like this:
Euler[y0_, f_, {x0_, xend_}, steps_Integer?Positive] := (* body *)
Notice the underscores to denote patterns, the := to denote delayed evaluation and the pattern specification Integer?Positive.
As for the body of the function -- oh my goodness could you have picked a less Mathematica-style approach? Perhaps not. Procedural loops and Append are almost never the best way to do anything in Mathematica.
Here is a better solution.
Euler[y_, y0_, f_, {x_, x0_, xend_}, steps_Integer?Positive] :=
With[{h = N[(xend - x0)/steps], ff = Function[{x, y}, f]},
NestList[{#[[1]] + h, ff[#[[1]], #[[2]]]*h + #[[2]]} &, {x0, y0},
steps]]
Euler[y, 2, -x y^2, {x, 0, 2}, 20]
{{0, 2}, {0.1, 2.}, {0.2, 1.96}, {0.3, 1.88317}, {0.4,
1.77678}, {0.5, 1.6505}, {0.6, 1.51429}, {0.7, 1.37671}, {0.8,
1.24404}, {0.9, 1.12023}, {1., 1.00728}, {1.1, 0.905822}, {1.2,
0.815565}, {1.3, 0.735748}, {1.4, 0.665376}, {1.5, 0.603394}, {1.6,
0.548781}, {1.7, 0.500596}, {1.8, 0.457994}, {1.9, 0.420238}, {2.,
0.386684}}
If you want something that outputs Euler[y, 2, -x y^2, {x, 0, 2}, 20], then typing it into the notebook is the quickest method.
I am attempting to graph the following function and indicate on the plot where the function passes 45 degree slope. I have been able to graph the function itself using the following code:
T = 170 Degree;
f[s_, d_] = Normal[Series[Tan[T - (d*s)], {s, 0, 4}]];
r[h_, d_] = Simplify[Integrate[f[s, d], {s, 0, h}]];
a[h_] = Table[r[h, d], {d, 1, 4, .5}];
Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 4}, {0, -4}}, AspectRatio -> 1]
I need to display the point on each curve where the slope exceeds 45 degrees. However, I have thus far been unable to even solve for the numbers, due to something odd about the hadling of tables in the Solve and Reduce functions. I tried:
Reduce[{a'[h] == Table[-1, {Dimensions[a[h]][[1]]}], h >= 0}, h]
But I apparently can't do this with this kind of function, and I am not sure how to add these results to the plot so that each line gets a mark where it crosses. Does anyone know how to set this up?
Here is your code, for completeness, with plot parameters slightly modified to zoom into the region of interest:
Clear[d,h,T,f,r,a];
T = 170 Degree;
f[s_, d_] = Normal[Series[Tan[T - (d*s)], {s, 0, 4}]];
r[h_, d_] = Simplify[Integrate[f[s, d], {s, 0, h}]];
a[h_] = Table[r[h, d], {d, 1, 4, .5}];
plot = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 0.8}, {0, -0.5}},
AspectRatio -> 1, Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10],
PlotStyle -> {Thickness[0.004]}]
Here is the code to get the solutions (h-coordinates):
In[42]:= solutions = Map[Reduce[{D[#, h] == -1, h >= 0}, h] &, a[h]]
Out[42]= {h == 0.623422, h == 0.415615, h == 0.311711, h == 0.249369,
h == 0.207807, h == 0.178121, h == 0.155856}
Now produce the plot:
points = ListPlot[MapIndexed[{#1, a[#1][[First##2]]} &, solutions[[All, 2]]],
PlotStyle -> Directive[PointSize[0.015], Red],
PlotRange -> {{0, 0.8}, {0, -0.5}}, AspectRatio -> 1,
Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10]]
Finally, combine the plots:
Show[{plot, points}]
Edit:
Responding to the request of cutting plots at the found points - here is one way:
plot =
With[{sols = solutions[[All, 2]]},
Plot[Evaluate[a[h]*UnitStep[sols - h]], {h, 0, 4},
PlotRange -> {{0, 0.8}, {0, -0.5}}, AspectRatio -> 1,
Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10],
PlotStyle -> {Thickness[0.004]}]]
and this should be executed after the solutions have been found.
Could find the points via:
slope45s =
h /. Map[First[Solve[D[#, h] == -1 && h >= 0, h]] &, a[h]]
Out[12]= {0.623422, 0.415615, 0.311711, 0.249369, 0.207807, 0.178121, \
0.155856}
Here we put together the list of relevant points.
pts = Transpose[{slope45s, Tr[a[slope45s], List]}]
Can now plot in any number of ways. Here is one such.
p2 = ListPlot[pts, PlotRange -> {{0, 4}, {0, -4}},
PlotStyle -> {PointSize[.01], Red}];
p1 = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 4}, {0, -4}},
AspectRatio -> 1];
Show[p1, p2]
(Being new to this modern world-- or rather, of an age associated with an earlier civilization-- I do not know how to paste in an image.)
(Okay, thanks Leonid. I think I have an image and also indented code.)
(But why are we talking in parentheses??)
Daniel Lichtblau
Wolfram Research
Edit: I did not much like the picture I gave. Here is one I think is more descriptive.
makeSegment[pt_, slope_, len_] :=
Rotate[Line[{pt + {-len/2, 0}, pt + {len/2, 0}}], ArcTan[slope]]
p2 = ListPlot[pts, PlotStyle -> {PointSize[.01], Red}];
p1 = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 2}, {0, -1}},
AspectRatio -> 1];
p3 = Graphics[Map[{Orange, makeSegment[#, -1, .2]} &, pts]];
Show[p1, p2, p3, AspectRatio -> 1/2, ImageSize -> 1000]