Related
Suppose I have a function like this.
u = (1 / 4 Sin[t] (1 - r^2)) ;
Plot[u,{r,0,1}]
The above command will plot "U" on Y-axis and "r" on X-axis, But I want it in the reverse direction. "U" on X-axis and "r" on Y-axis.
How to do this, I'm new to Mathematica.
Many thanks for considering my request.
You can tabulate the results using Table and reverse each data point
Clear[t, u]
u[r_] := (1/4 Sin[t] (1 - r^2));
t = 1.57;
ru = ListLinePlot[table = Table[{r, u[r]}, {r, 0, 1, 0.01}],
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {r, u}];
ur = ListLinePlot[Reverse /# table,
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {u, r}];
GraphicsRow[{ru, ur}]
Or you can generate an inverse function to use in Plot
Clear[t, u]
u[r_] := (1/4 Sin[t] (1 - r^2));
t = 1.57;
plotru = Plot[u[r], {r, 0, 1},
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {r, u}];
Clear[t, u]
v = Quiet[InverseFunction[(1/4 Sin[t] (1 - #^2)) &]];
t = 1.57;
plotur = Plot[-v[x], {x, 0, 0.25},
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {u, r}];
GraphicsRow[{plotru, plotur}]
I found the answer to this Question using the ParametricPlot command
ParametricPlot[{(1 - r^2) /. r -> Abs[r], r}, {r, -Pi, Pi}]
We're asking NDSolve to solve x'' + x == 0 to 20 digits, but when we compare to the true solution, we only see 9 correct digits. Are we not using NDSolve correctly?
Clear["Global`*"]
sol = NDSolve[{x'[t] == v[t], v'[t] == -x[t], x[0] == 1, v[0] == 0}, {x, v},
{t, 0, 100},
PrecisionGoal -> 20, AccuracyGoal -> 20, WorkingPrecision -> 40, MaxSteps -> 10^6];
Plot[(x[t] - Cos[t]) /. sol[[1]], {t, 0, 100}]
Ok! I'm working towards building a nested manipulate command that will solve n number of damped oscillating masses in series (with fixed endpoints). I have everything pretty much working but I have one problem - when I increase the number of oscillators, my initial conditions lag behind a bit. For example, if I set n to 4, Mathematica says I still only have 2 initial conditions (the starting number - position and velocity for one oscillator). When I then move to 3, I now have 8 (from my 4 oscillators) - which is too many for the state space equations, and it all fails. What is going on?
(Yes, I know that my initial conditions aren't going to be put in correctly yet, I'm just trying to get them to match up first).
coupledSMD[n_, m_, k_, b_, f_, x0_, v0_, tmax_] :=
Module[{aM, bM, cM, dM},
aM = Join[Table[Boole[i == j - n], {i, n}, {j, 2 n}],
Join[
If[n != 1,DiagonalMatrix[-2 k/m Table[1, {n}]] +
k/m DiagonalMatrix[Table[1, {n - 1}], 1] +
k/m DiagonalMatrix[Table[1, {n - 1}], -1],
{{-2 k/m}}],
If[n != 1,DiagonalMatrix[-2 b/m Table[1, {n}]] +
b/m DiagonalMatrix[Table[1, {n - 1}], 1] +
b/m DiagonalMatrix[Table[1, {n - 1}], -1],
{{-2 b/m}}], 2]];
bM = Join[Table[0, {n}, {1}], Table[1/m, {n}, {1}]];
cM = Table[Boole[i == j], {i, n}, {j, 2 n}];
dM = Table[0, {n}, {1}];
OutputResponse[
{StateSpaceModel[{aM, bM, cM, dM}], Flatten[Join[x0, v0]]},
f, {t, 0, tmax}]
]
Manipulate[
With[{
x0s = Table[Subscript[x, i, 0], {i, 1, n}],
v0s = Table[Subscript[v, i, 0], {i, 1, n}],
initialx = Sequence ## Table[{{Subscript[x, i, 0], 0}, -10, 10}, {i, 1, n}],
initialv = Sequence ## Table[{{Subscript[v, i, 0], 0}, -10, 10}, {i, 1, n}]},
Manipulate[
myplot = coupledSMD[n, m, k, b, f, x0s, v0s, tmax];
Plot[myplot, {t, 0, tmax}, PlotRange -> yheight {-1, 1},
PlotLegends -> Table[Subscript[x, i, 0], {i, 1, n}]],
Style["Initial Positions", Bold],
initialx,
Delimiter,
Style["Initial Velocities", Bold],
initialv,
Delimiter,
Style["System conditions", Bold],
{{m, 1, "Mass(kg)"}, 0.1, 10, Appearance -> "Labeled"},
{{k, 1, "Spring Constant(N/m)"}, 0.1, 10, Appearance -> "Labeled"},
{{b, 0, "Damping Coefficient(N.s/m)"}, 0, 1, Appearance -> "Labeled"},
{{f, 0, "Applied Force"}, 0, 10, Appearance -> "Labeled"},
Delimiter,
Style["Plot Ranges", Bold],
{tmax, 10, 100},
{{yheight, 10}, 1, 100},
Delimiter,
ControlPlacement -> Flatten[{Table[Right, {2 n + 2}], Table[Left, {8}]}]
]],
{n, 1, 4, 1}
]
Edit: Updated the code. It works now, but I'm still getting the errors. I'm guessing that it has something to do with a time lag in the updating process? - That some parts are getting updated before others. Again, it seems to be working perfectly, except it throws these errors (the errors seem superfluous to me, as if they are remnants in the code, but not actually causing a problem)
But I don't really know what I'm talking about :)
I have this matrix
a = {{2, -2, -4}, {-2, 5, -2}, {-4, -2, 2}}
I then solved an equation with one missing entry. The equation is of the form
Inverse[p].a.p == q
where p is the 3x3 matrix with the missing entry (x5) and q is a given 3x3 matrix.
Solve[Inverse[( {
{1/Sqrt[5], 4/(3 Sqrt[5]), -2/3},
{-2/Sqrt[5], 2/(3 Sqrt[5]), -2/6},
{0, x5, -2/3}
} )].a.( {
{1/Sqrt[5], 4/(3 Sqrt[5]), -2/3},
{-2/Sqrt[5], 2/(3 Sqrt[5]), -2/6},
{0, x5, -2/3}
} ) == ( {
{6, 0, 0},
{0, 6, 0},
{0, 0, -3}
} )]
Mathematica can solve this easily and I get x5 -> -(Sqrt[5]/3) as the result.
However if I check it, the result ist very weird:
In[2]:= Inverse[( {
{1/Sqrt[5], 4/(3 Sqrt[5]), -2/3},
{-2/Sqrt[5], 2/(3 Sqrt[5]), -2/6},
{0, -Sqrt[5]/3, -2/3}
} )].a.( {
{1/Sqrt[5], 4/(3 Sqrt[5]), -2/3},
{-2/Sqrt[5], 2/(3 Sqrt[5]), -2/6},
{0, -Sqrt[5]/3, -2/3}
} )
Out[2]= {{6/5 - (2 (-(2/Sqrt[5]) - 2 Sqrt[5]))/Sqrt[5],
8/5 + (2 (-(2/Sqrt[5]) - 2 Sqrt[5]))/(3 Sqrt[5]), -(4/Sqrt[5]) +
1/3 (2/Sqrt[5] + 2 Sqrt[5])}, {-((
2 (-(8/(3 Sqrt[5])) + (4 Sqrt[5])/3))/Sqrt[5]) + (
4/(3 Sqrt[5]) + (4 Sqrt[5])/3)/Sqrt[5],
10/3 + (2 (-(8/(3 Sqrt[5])) + (4 Sqrt[5])/3))/(3 Sqrt[5]) + (
4 (4/(3 Sqrt[5]) + (4 Sqrt[5])/3))/(3 Sqrt[5]), (4 Sqrt[5])/3 +
1/3 (8/(3 Sqrt[5]) - (4 Sqrt[5])/3) -
2/3 (4/(3 Sqrt[5]) + (4 Sqrt[5])/3)}, {0, 0, -3}}
the expected result should be
( {
{6, 0, 0},
{0, 6, 0},
{0, 0, -3}
} )
like in the equation. If I calculate this by hand I get this result. What am I missing here?
Just Simplify or Expand the results.
Here is an example:
In[1]:= a = {{2, -2, -4}, {-2, 5, -2}, {-4, -2, 2}}
Out[1]= {{2, -2, -4}, {-2, 5, -2}, {-4, -2, 2}}
In[2]:= p = {{1/Sqrt[5], 4/(3 Sqrt[5]), -(2/3)}, {-(2/Sqrt[5]), 2/(
3 Sqrt[5]), -(2/6)}, {0, x5, -(2/3)}}
Out[2]= {{1/Sqrt[5], 4/(3 Sqrt[5]), -(2/3)}, {-(2/Sqrt[5]), 2/(
3 Sqrt[5]), -(1/3)}, {0, x5, -(2/3)}}
In[3]:= sol =
Solve[Inverse[p].a.p == {{6, 0, 0}, {0, 6, 0}, {0, 0, -3}}]
Out[3]= {{x5 -> -(Sqrt[5]/3)}}
In[4]:= Inverse[p].a.p /. sol[[1]]
Out[4]= <big output removed>
In[5]:= Simplify[%]
Out[5]= {{6, 0, 0}, {0, 6, 0}, {0, 0, -3}}
Expand would work too in place of Simplify. Expressions in terms of roots and fractions can often be written in several ways, and it's not immediately obvious if two expression are equivalent just by looking at them. You have to explicitly ask Mathematica to transform them, for example expr = 13/(2 Sqrt[3]) - 4/3 and Together[expr].
What is quite strange though, is that Solve does not work if you use the standard syntax and give variables explicitly:
In[6]:= Solve[Inverse[p].a.p == {{6, 0, 0}, {0, 6, 0}, {0, 0, -3}}, x5]
Out[6]= {}
In[7]:= Solve[
Inverse[p].a.p == {{6, 0, 0}, {0, 6, 0}, {0, 0, -3}}, x5,
VerifySolutions -> False]
Out[7]= {}
Can anyone explain why? NSolve works as expected.
In[8]:= NSolve[
Inverse[p].a.p == {{6, 0, 0}, {0, 6, 0}, {0, 0, -3}}, x5]
Out[8]= {{x5 -> -0.745356}}
Remove["Global`*"];
a = {{2, -2, -4}, {-2, 5, -2}, {-4, -2, 2}};
p = {{1/Sqrt[5], 4/(3 Sqrt[5]), -2/3}, {-2/Sqrt[5],
2/(3 Sqrt[5]), -2/6}, {0, x, -2/3}};
pInv = Inverse[p];
lhs = pInv.a.p;
q = {6, 6, -3};
eqs = N#Expand#
Map[Total[lhs[[#, All]]] - q[[#]] == 0 &, Range[Length[q]]]
Here are the 3 equations all in x. (3 equations, ONE unknown!)
-6. - 2.66667/(-0.444444 + 0.745356 x) + (4.47214 x)/(-0.444444 + 0.745356 x) ==
0.,
-6. - 2.66667/(-0.444444 + 0.745356 x) + (4.47214 x)/(-0.444444 + 0.745356 x) == 0.,
3. - 0.654283/(-0.444444 + 0.745356 x) -(1.5694 x)/(-0.444444 + 0.745356 x) + (
4.47214 x^2)/(-0.444444 + 0.745356 x) == 0.
first solve numerically
Map[NSolve[eqs[[#]],x]&,Range[3]]
Out[465]= {{{x->0.}},{{x->0.}},{{x->-0.745356}}}
To get Solve to accept x, First do not do Numerical, leave it symbolic:
eqs = Expand# Map[Total[lhs[[#, All]]] - q[[#]] == 0 &, Range[Length[q]]]
which gives
{-6 - 8/(3 (-(4/9) + (Sqrt[5] x)/3)) + (2 Sqrt[5] x)/(-(4/9) + (Sqrt[5] x)/3) ==
0,
-6 - 8/(3 (-(4/9) + (Sqrt[5] x)/3)) + (2 Sqrt[5] x)/(-(4/9) + (Sqrt[5] x)/3) == 0,
3 + 4/(3 (-(4/9) + (Sqrt[5] x)/3)) - (8 Sqrt[5])/(9 (-(4/9) + (Sqrt[5] x)/3))
+ (2 x)/(3 (-(4/9) + (Sqrt[5] x)/3)) - (
Sqrt[5] x)/(-(4/9) + (Sqrt[5] x)/3) + (
2 Sqrt[5] x^2)/(-(4/9) + (Sqrt[5] x)/3) == 0}
Now use Solve, with explicit x in there, now it is ok
Map[Solve[eqs[[#]], x] &, Range[3]]
{{{}}, {{}}, {{x -> -(Sqrt[5]/3)}}}
--Nasser
What is a good way to draw a smooth curve with specified starting and ending point and restricted to be inside of a piecewise linear tube like below?
(source: yaroslavvb.com)
coords = {1 -> {0, 2}, 2 -> {1/3, 1}, 3 -> {0, 0},
4 -> {(1/3 + 2)/2, 1}, 5 -> {2, 1}, 6 -> {2 + 1/3, 0},
7 -> {2 + 1/3, 2}};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract ### pr);
lineThickness = 2/3;
graph = {1 -> 2, 3 -> 2, 2 -> 4, 4 -> 5, 5 -> 6, 5 -> 7};
path = {3, 2, 4, 5, 7};
lp = Graphics[{Blue, Opacity[.5],
AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[lp, gp, PlotRange -> pr, ImageSize -> is]
Perhaps something like this:
coords = {2 -> {1/3, 1}, 1 -> {0, 0}, 3 -> {(1/3 + 2)/2, 1},
4 -> {2, 1}, 5 -> {2 + 1/3, 2}};
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract ### pr);
lineThickness = 2/3;
graph = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
path = {1, 2, 3, 4, 5};
f = BezierFunction[
SortBy[coords /. Rule[x_, List[a_, b_]] -> List[a, b], First]];
pp = ParametricPlot[f[t], {t, 0, 1}];
lp = Graphics[{Blue, Opacity[.5],
AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[pp, lp, gp, PlotRange -> pr, ImageSize -> is]
You may gain a better control over the path by adding/removing control points for the Bezier. As I remember "A Bspline is contained in the convex hull of its control points", so you can add control points inside your thick lines (up and down the middlepoints in actual point set, for example) to bound the Bezier more and more.
Edit
The following is a first try to bound the curve. Bad programming, just to get the feeling of what can be done:
coords = {2 -> {1/3, 1}, 1 -> {0, 0}, 3 -> {(1/3 + 2)/2, 1},
4 -> {2, 1}, 5 -> {2 + 1/3, 2}};
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract ### pr);
lineThickness = 2/3;
graph = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
path = {1, 2, 3, 4, 5};
kk = SortBy[coords /. Rule[x_, List[y_, z_]] -> List[y, z],
First]; f = BezierFunction[kk];
pp = ParametricPlot[f[t], {t, 0, 1}, Axes -> False];
mp = Table[{a = (kk[[i + 1, 1]] - kk[[i, 1]])/2 + kk[[i, 1]],
Interpolation[{kk[[i]], kk[[i + 1]]}, InterpolationOrder -> 1][
a] + lineThickness/2}, {i, 1, Length[kk] - 1}];
mp2 = mp /. {x_, y_} -> {x, y - lineThickness};
kk1 = SortBy[Union[kk, mp, mp2], First]
g = BezierFunction[kk1];
pp2 = ParametricPlot[g[t], {t, 0, 1}, Axes -> False];
lp = Graphics[{Blue, Opacity[.5],
AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[pp, pp2, lp, gp, PlotRange -> pr, ImageSize -> is]
Edit 2
Or perhaps better yet:
g1 = Graphics[BSplineCurve[kk1]];
Show[lp, g1, PlotRange -> pr, ImageSize -> is]
This one scales quite well when you enlarge the image (the previous ones don't)