How to fix the procedure - wolfram-mathematica

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.

Related

How to write a procedure?

Hello! Help me please to make a procedure from my program code.
I've got code, which includs 2 parts (they're Graphics[...]), it plots functions with rectengles.
But it seems to be too much code, so I have to write a procedure with an argument of a function and then when I call it, this procedure would do the same (plots functions with rectengles). (can somehows to use spx1,spx2.)
This is whole code:
(*Sin[x]*)
data1 = Table[{x, Sin[x]}, {x, -1, 6, 0.1}];
data11 = data1[[;; , 2]];(*отримуємо набір ординат*)localmins1 =
Pick[data1, MinDetect[data11, 10^-6], 1];
localmaxs1 = Pick[data1, MaxDetect[data11, 10^-6], 1];
Graphics[{Thick, Blue, Line[data1], Red, PointSize[0.01],
Point[localmins1], Point[localmaxs1]}, Axes -> True];
spx1 = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 6};
Graphics[{Thick, Blue, Line[data1], Red, PointSize[0.01],
Point[localmins1], Point[localmaxs1],
Point[{{-1, 0}, {1.6, 0}, {-0.35, 0}, {0.3, 0}, {0.95, 0}}], Green,
Point[{{-0.35, -0.1342898}, {0.3, 0.29552}, {0.95, 0.813416}}], Red,
Point[{{2.375, 0}, {3.15, 0}, {3.925, 0}, {4.7, 0}}], Green,
Point[{{2.375, 0.693685}, {3.15, -0.0084}, {3.925, -0.70569766}}],
Pink, Opacity[.7], EdgeForm[Directive[Dashed, Pink]],
Rectangle[{-1, -0.84147}, {-0.35, -0.342898}],
Rectangle[{-0.35, -0.342898}, {0.3, 0.29552}],
Rectangle[{0.3, 0.29552}, {0.95, 0.813416}],
Rectangle[{0.95, 0.813416}, {1.6`, 0.9995736030415051`}],
Rectangle[{1.6, 0.99957}, {2.375, 0.693685}],
Rectangle[{2.375, 0.693685}, {3.15, -0.0084}],
Rectangle[{3.15, -0.0084}, {3.925, -0.70569766}],
Rectangle[{3.925, -0.70569766}, {4.7, -0.9999}],}, Axes -> True]
(*Cos[x]*)
data2 = Table[{x, Cos[x]}, {x, -3, 4, 0.1}]; data22 =
data2[[;; , 2]];(*отримуємо набір ординат*)localmins2 =
Pick[data2, MinDetect[data22, 10^-6], 1];
localmaxs2 = Pick[data2, MaxDetect[data22, 10^-6], 1];
Graphics[{Thick, Blue, Line[data2], Red, PointSize[0.01],
Point[localmins2], Point[localmaxs2]}, Axes -> True];
spx2 = {-3,-2.25, -1.5, -0.75,0, 0.75, 1.5, 2.25, 3};
spxrozb11 = {-3, -2.25, -1.5, -0.75, 0};
spxrozb22 = {0, 0.75, 1.5, 2.25, 3};
Graphics[{Thick, Blue, Line[data2], Red, PointSize[0.01],
Point[localmins2], Point[localmaxs2],
Point[{{-2.25, 0}, {-1.5, 0}, {-0.75, 0}, {0, 0}}], Green,
Point[{{-2.25, -0.628}, {-1.5, 0.07}, {-0.75, 0.73}}], Red,
Point[{{0.75, 0}, {1.5, 0}, {2.25, 0}, {3, 0}}], Green,
Point[{{0.75, 0.7316}, {1.5, 0.07}, {2.25, -0.628}}], Pink,
Opacity[.7], EdgeForm[Directive[Dashed, Pink]],
Rectangle[{-3, -0.989992}, {-2.25, -0.628}],
Rectangle[{-2.25, -0.628}, {-1.5, 0.07}],
Rectangle[{-1.5, 0.07}, {-0.75, 0.7316}],
Rectangle[{-0.75, 0.7316}, {1.6653345369377348`*^-16, 1.`}],
Rectangle[{1.6653345369377348`*^-16, 1.`}, {0.75, 0.7316}],
Rectangle[{0.75, 0.7316}, {1.5, 0.07}],
Rectangle[{1.5, 0.07}, {2.25, -0.628}],
Rectangle[{2.25, -0.628}, {3.1000000000000005`, \
-0.9991351502732795`}]}, Axes -> True]
I tried to write the first step in procedure, and even it doesn't work;(
f1 = Table[{x, Sin[x]}, {x, -1, 6, 0.1}];
f2 = Table[{x, Cos[x]}, {x, -3, 4, 0.1}];
data = {f1, f2};
spx1 = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 6};
graph[i_] :=
Graphics[For[i = 0, i < 3,
i++, {Thick, Blue, Line[data[[i]]], Red, Point[{spx1[[i]], 0}]}]]
graph[1]
******How to write For in procedure correctly?******

Mathematica code doesn't work when using version 9

I have written the following code which works ok in Mathematica 8. However, when I open the very same notebook in Mathematica 9, the following message arises: "InterpolatingFunction::dmval: "Input value {0.000408163} lies outside the range of data in the interpolating function. Extrapolation will be used. ", and there is no graph.
Here's the code:
Manipulate[
ParametricPlot[
Evaluate[{x1[t], a YP[[2]]/YP[[1]] x1[t] + (1 - a) YP[[2]] x3[t]} /.
Quiet#NDSolve[
{x1'[t] == x2[t],
x2'[t] == -1/
Mass (c x2[t] +
a YP[[2]]/YP[[1]] x1[t] + (1 - a) YP[[2]] x3[t] -
Fmax Sin[(2 π)/T t]),
x3'[t] ==
x2[t]/YP[[
1]] (1 - Abs[x3[t]]^n (γ Sign[x2[t] x3[t]] + (1 - γ))),
x1[0] == 0,
x2[0] == 0,
x3[0] == 0},
{x1[t], x2[t], x3[t]},
{t, 0, tTotal}]],
{t, 0, tTotal},
ImageSize -> {450, 450}, PlotRange -> 10, AxesLabel -> {"u", "F"}],
{{tTotal, 20, "Total time"}, 0.5, 100, Appearance -> "Labeled"},
{{Mass, 2.86, "m"}, 0.1, 10, 0.01, Appearance -> "Labeled"},
{{T, 4.0, "T"}, 0.1, 10, 0.01, Appearance -> "Labeled"},
{{Fmax, 8.0, "Fmax"}, 0.1, 10, 0.01, Appearance -> "Labeled"},
{{n, 2.0, "n"}, 0.1, 10, 0.01, Appearance -> "Labeled"},
{{c, 0.0, "c"}, 0.0, 10, 0.01, Appearance -> "Labeled"},
{{a, 0.05, "a"}, 0.0, 1, 0.01, Appearance -> "Labeled"},
{{γ, 0.5, "γ"}, 0.01, 1, 0.01, Appearance -> "Labeled"},
{{YP, {0.111, 2.86}}, {0, 0}, {10, 10}, Locator}]
Any ideas?
TIA
Summarising the problem. This works in version 7 & 8 but fails in version 9:-
tTotal = 20; Mass = 2.86; T = 4.0;
Fmax = 8.0; n = 2.0; c = 0.0; a = 0.05;
\[Gamma] = 0.5; YP = {0.111, 2.86};
NDSolve[{x1'[t] == x2[t],
x2'[t] == -1/Mass (c x2[t] + a YP[[2]]/YP[[1]] x1[t] +
(1 - a) 2.86 x3[t] - Fmax Sin[(2 \[Pi])/4.0 t]),
x3'[t] == x2[t]/0.111 (1 -
Abs[x3[t]]^2.0 (\[Gamma] Sign[x2[t] x3[t]] + (1 - \[Gamma]))),
x1[0] == 0, x2[0] == 0, x3[0] == 0},
{x1[t], x2[t], x3[t]}, {t, 0, 20}]
Use a more specific method in version 9.
NDSolve[... , Method -> {"DiscontinuityProcessing" -> False}]

solve rotationtransform

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
*)

Plotting Interpolations in Mathematica

It's apparently very simple but I can't find my mistake. The Plot gives me no points at all.
tmax = 1.;
nmax = 10;
deltat = tmax/nmax;
h[t_, s_] := t^2 + s^2;
T = Table[{{n*deltat}, {n*deltat}, h[n*deltat, n*deltat]}, {n, 0, nmax}]
inth = ListInterpolation[T]
Plot3D[inth[s, t], {s, 0, 1}, {t, 0, 1}]
Any help would be mostly welcome!
Marco
I think your "T" is supposed to be a list of 3D points, in which case you should generate it with:
tmax = 1.;
nmax = 10;
deltat = tmax/nmax;
h[t_, s_] := t^2 + s^2;
T = Table[{n*deltat, n*deltat, h[n*deltat, n*deltat]}, {n, 0, nmax}]
inth = ListInterpolation[T]
Plot3D[inth[s, t], {s, 0, 1}, {t, 0, 1}]
Now T[[1]] = {0., 0., 0.} and not {{0.}, {0.}, 0.} as before.

Transform(align) a plane plot into a 3D plot in Mathematica

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}}]

Resources