Related
I am going to have a n-dimensional function and I would like to able plot 2D planes for the rest of the variables fixed to a number. For example:
u = w^2 y^3 + x^5 z^4 + I z^6 + I z^2 Sin[y + x - 1]+k*Sin[w*pi]
I have 5 variables in here and lets assume I want to fix z w plane and plot with sliding y,z, and k. I have many issues to fix to get what I want to do,
1- As it is the code is not working. I need to figure out to update the limsL and limsR for the sliders. If I remove the doloop and the limits at least I dont get the RED error bar. I need to update those values maybe using a button to get all the data and second button to plot.
2- But even with default limits for sliders [0,1] I do not get a plot. The values are updated at the interface. Under varying variables but does not effect the u function. And actually I prefer variables stay as z,y,x etc and not to get numerical values.
Manipulate[DynamicModule[{u =
z Sin[\[Pi] x] + Cos[\[Pi] y] + y^6 Cos[2 \[Pi] y], vars = {x, y, z}, varlims = {{1, 2}, {3, 4}, {5, 6}}, poi = {x, y},
svars = {z, r}, data = Table[RandomReal[], {20}]}, Column[{Style["Ploter", "Function"],
Row[{"Function ", InputField[u]}, Spacer[20]],
Row[{"Variables ", InputField[Dynamic[vars]]}],
Row[{"Variable limits ", InputField[Dynamic[varlims]]}],
Row[{"Plane of interest", InputField[Dynamic[poi]]}],
Row[{"Varying variables", InputField[Dynamic[svars]]}],
Plotslices[u, vars, varlims, poi, svars, size],
Dynamic[
countersvar = Dimensions[svars][[1]];
limsL = ConstantArray[0, countersvar];
limsR = ConstantArray[0, countersvar];
Do[
v = svars[[i]];
posv = Position[vars, v][[1]];
lv = varlims[[posv, 1]][[1]];
rv = varlims[[posv, 2]][[1]];
limsL[[i]] = lv;
limsR[[i]] = rv;
, {i, countersvar}];
Grid[
Table[With[{i = i}, {svars[[i]],
Slider[Dynamic[svars[[i]], {limsL[[1]], limsR[[i]]}]],
Dynamic[svars[[i]]]}], {i, Dimensions[svars][[1]]}]]]
}]], {size, {Small, Medium, Full}}, ControlPlacement -> Bottom,ContinuousAction -> False, Initialization :> (
Plotslices[u_, vars_, varlims_, poi_, svars_, size_] :=
Module[{v1, v2, lv1, lv2, rv1, rv2, posv1, posv2},
v1 = poi[[1]];
v2 = poi[[2]];
posv1 = Position[vars, v1][[1]];
posv2 = Position[vars, v2][[1]];
lv1 = varlims[[posv1, 1]][[1]];
lv2 = varlims[[posv2, 1]][[1]];
rv1 = varlims[[posv1, 2]][[1]];
rv2 = varlims[[posv2, 2]][[1]];
psl =
Plot3D[u, {v1, lv1, rv1}, {v2, lv2, rv2},
PerformanceGoal -> "Quality", Mesh -> None,
ColorFunction -> Function[{v1, v2, z}, Hue[z]],
ImageSize -> size];
Return[psl];];
)
]
I am sorry for the formatting . I tried to put it together crtl+K but it did not work.
Help me, please!
There's the procedure operation[f_].
It works correctly and plot for functions:Cos,Sin. But, Unfortunately, it doesn't work for E^x and Log[E,x] and outputs errors, maybe because inputting not correct name of function or something else;(( What's the problem?
spxsin = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 5.025,
5.35, 5.675, 6};
spxcos = {-1, -0.75, -0.5, -0.25, 0, 0.775, 1.55, 2.325, 3.1, 3.825,
4.55, 5.275, 6};
spxlny = {-1, 0.75, 2.5, 4.25, 6};
spxey = {-1, 0.75, 2.5, 4.25, 6};
operation[f_] := Block[{data},
data = Table[{x, f[x]}, {x, -1, 6, 0.1}];
Graphics[{Thick, Blue, Line[data],
Green, Table[Point[{spx[[i]], f[spx[[i]]]}], {i, 1, Length[spx]}],
Pink, Opacity[.7],
Table[Rectangle[{spx[[i]], f[spx[[i]]]}, {spx[[i + 1]],
f[spx[[i + 1]]]}], {i, 1, Length[spx] - 1}]
}, Axes -> True]]
Which[ f == Sin, spx := spxsin, f == Cos, spx := spxcos, f == E^x ,
spx := spxlny, f == Log, spx := spxey]
operation[Sin]
operation[Cos]
operation[E^x]
operation[Log]
Edit now tested: you can pass pure functions to your operation, so instead of: operation[E^x] try
operation[E^# &]
or for example if you wanted a base 2 log it would be
operation[Log[2,#]&]
A few other things to point out: Log fails simply because your x table range is negative.
Also, the Which statement you have doesn't do anything. Being outside your function, f is not defined so none of the conditionals are True. Moving Which inside the function, this works:
spxsin = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 5.025,
5.35, 5.675, 6};
spxcos = {-1, -0.75, -0.5, -0.25, 0, 0.775, 1.55, 2.325, 3.1, 3.825,
4.55, 5.275, 6};
spxlny = {-1, 0.75, 2.5, 4.25, 6};
spxey = {-1, 0.75, 2.5, 4.25, 6};
operation[f_] :=
Block[{data}, data = Table[{x, f[x]}, {x, -1, 6, 0.1}];
Clear[spx];
Which[
TrueQ[f == Sin], spx := spxsin,
TrueQ[f == Cos], spx := spxcos ,
TrueQ[f == (E^# &)], spx := spxey ];
Graphics[{Thick, Blue, Line[data], Green,
Table[{PointSize[.1], Point[{spx[[i]], f[spx[[i]]]}]}, {i, 1, Length[spx]}],
Pink, Opacity[.7],
Table[Rectangle[{spx[[i]], f[spx[[i]]]}, {spx[[i + 1]],
f[spx[[i + 1]]]}], {i, 1, Length[spx] - 1}]}, Axes -> True,
AspectRatio -> 1/GoldenRatio]]
Note each which test is wrapped in TrueQ to ensure it is either True or False ( the test Sin==Cos is not false for all values and so does not return False )
operation[Sin]
operation[Cos]
operation[E^# &]
Now if you want Exp to also work you need to explicitly put that form in your Which statement. ( f==(E^#&) || f==Exp )
Euler's E needs to be entered as Esc ee Esc.
It looks to me at you entered is a standard E.
Note also that Exp is the exponential function in Mathematica.
I am trying to add this parametric plot only in the z-axis (right now when I add it expands in the x,y, and z), the effect of this summation would be addition of amplitudes of the sine waves. Here is what I have now. http://imgur.com/j9hN7VR
Here is the code I am using to implement it:
frequency = 1000;
speed = 13397.2441;
wavelength = speed/frequency;
s = (r - 2);
t = (r - 4);
u = (r - 6);
v = (r - 8);
ParametricPlot3D[{{r*Cos[q] - 4, r*Sin[q], Sin[(2*Pi)/wavelength*(r)]},
{s*Cos[q] - 2, s*Sin[q], Sin[(2*Pi)/wavelength*(s + wavelength/4 - 1)]},
{t*Cos[q], t*Sin[q], Sin[(2*Pi)/wavelength*(t + wavelength/4 + 0.5)]},
{u*Cos[q] + 2, u*Sin[q], Sin[(2*Pi)/wavelength*(u + wavelength/4 + 1.65)]},
{v*Cos[q] + 4, v*Sin[q], Sin[(2*Pi)/wavelength*(v + wavelength/4 + 3.5)]}},
{r, 0, 25}, {q, 0, Pi}, PlotPoints -> 30, Mesh -> 20, PlotRange -> {{-25, 25}, {0, 35}, {-6, 6}}]
Any suggestions would be greatly appreciated!
Unfortunately I could not find an answer for this, so I ended up just simulating in MATLAB instead by generating all values over the field (in a matrix) and then summing as I was trying to do here.
I have an issue with the reconstrution of a affine transformation matrix.
The translation matrix reconstructions works just fine, but not the rotation.
Thank you guys!
(*Works just fine*)
Clear["Global`*"]
data = RandomReal[10, {100, 3}];
data0 = TranslationTransform[{1, -1, 1}]#data;
{dX0, dY0, dZ0} /.
Solve[data0 == TranslationTransform[{dX0, dY0, dZ0}]#data, {dX0, dY0,
dZ0}]
(*Yields {} ????*)
Clear["Global`*"]
data = RandomReal[10, {10, 3}];
data0 = RotationTransform[10 , {1, 0, 0}]#data;
Solve[data0 == RotationTransform[aZ0 Degree, {0, 0, 1}]#data, {aZ0}]
You have too many equations for only one var.
data = RandomReal[1, {10, 3}];
data0 = RotationMatrix[1/2, {1, 0, 0}].# & /# data;
Solve[Thread[data[[1]] == RotationMatrix[aZ0, {1, 0, 0}].data0[[1]]][[2]], {aZ0}]
(*
-> -0.5
*)
I have an ODE and I solve it with NDSolve, then I plot the solution on a simplex in 2D.
Valid XHTML http://ompldr.org/vY2c5ag/simplex.jpg
Then I need to transform (align or just plot) this simplex in 3D at coordinates (1,0,0),(0,1,0),(0,0,1), so it looks like this scheme:
Valid XHTML http://ompldr.org/vY2dhMg/simps.png
I use ParametricPlot to do my plot so far. Maybe all I need is ParametricPlot3D, but I don't know how to call it properly.
Here is my code so far:
Remove["Global`*"];
phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y);
betam = 0.5;
betaf = 0.5;
betam = s;
betaf = 0.1;
sigma = 0.25;
beta = 0.3;
i = 1;
Which[i == 1, {betam = 0.40, betaf = 0.60, betam = 0.1,
betaf = 0.1, sigma = 0.25 , tmax = 10} ];
eta[x2_, y2_, p2_] = (betam + betaf + sigma)*p2 - betam*x2 -
betaf*y2 - phi[x2, y2];
syshelp = {x2'[t] == (betam + betaf + sigma)*p2[t] - betam*x2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*x2[t],
y2'[t] == (betaf + betam + sigma)*p2[t] - betaf*y2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*y2[t],
p2'[t] == -(betam + betaf + sigma)*p2[t] + phi[x2[t], y2[t]] -
eta[x2[t], y2[t], p2[t]]*p2[t]};
initialcond = {x2[0] == a, y2[0] == b, p2[0] == 1 - a - b};
tmax = 50;
solhelp =
Table[
NDSolve[
Join[initialcond, syshelp], {x2, y2, p2} , {t, 0, tmax},
AccuracyGoal -> 10, PrecisionGoal -> 15],
{a, 0.01, 1, 0.15}, {b, 0.01, 1 - a, 0.15}];
functions =
Map[{y2[t] + p2[t]/2, p2[t]*Sqrt[3]/2} /. # &, Flatten[solhelp, 2]];
ParametricPlot[Evaluate[functions], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> Automatic]
Third day with Mathematica...
You could find a map from the triangle in the 2D plot to the one in 3D using FindGeometricTransformation and use that in ParametricPlot3D to plot your function, e.g.
corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]],
PadRight[#, 3] & /# Append[pts1, Mean[pts1]],
"Transformation" -> "Affine"][[2]]
ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & ### functions],
{t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
Since your solution has the property that x2[t]+y2[t]+p2[t]==1 it should be enough to plot something like:
functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];
ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]