Selectively plotting functions using Manipulate - plot

I'd like to plot the solution region to a system of linear equations, but I want to be able to plot one equation at a time (and then "layer" them) instead of all at once. I'm having trouble figuring out how to do that using the Manipulate function. Do I use CheckboxBar? Here's what I have so far:
points1 := Table[{i - 1, j - 1}, {i, 70}, {j, 70}]
Show[ListPlot[points1, PlotRange -> {{0, 70}, {0, 70}}, ImageSize -> 850,
AxesLabel -> {"Racing Cars", "Sport-Utility Cars"}, PlotStyle ->
Directive[RGBColor[0.45, 0.67, 0.82, 0.82], PointSize[0.005]], LabelStyle ->
Medium],
RegionPlot[{R <= 40, S <= 60, R + S >= 70}, {R, 0, 70}, {S, 0, 70},
PlotLegends -> "Expressions"]]
What I don't want is to have the ability to plot only one equation at a time. E.g.,
Manipulate[Plot[function[frequency*x + phase], {x, -6.6, 6.6}], {frequency, 1, 5},
{phase, 1, 10}, {function, {Sin, Cos, Tan}}]
(Sorry, newbie here... I promise that I did do a thorough Google search, but none of the examples I found have been helpful to my situation.)
Many thanks!

Your comment in the post has a syntax error. RegionPlot needs at two variables defined.
Manipulate[
Show[
RegionPlot[R <= 40, {R, 0, 70}, {S, 0, 70}, PlotStyle -> {Opacity[plot1], Orange}],
RegionPlot[S <= 60, {R, 0, 70}, {S, 0, 70}, PlotStyle -> {Opacity[plot2], Blue}],
RegionPlot[R + S >= 70, {R, 0, 70}, {S, 0, 70}, PlotStyle -> {Opacity[plot3], Brown}]
],
{{plot1, 0, "R <= 40"}, {0, .5}, Checkbox},
{{plot2, 0, "S <= 60"}, {0, .5}, Checkbox},
{{plot3, 0, "R + S >= 70"}, {0, .5}, Checkbox},
ControlPlacement -> Left]
Hope this helps.

Related

How can I label axes using RegionPlot3D in Mathematica?

I would like to have a means to plot a solid in R^3 using RegionPlot3D and view it from a specified point on one of the axes so that the remaining axes appear in a specified manner. For example, suppose I wish to view the plane x+y+z=1 from the point (0,0,5) in such a way that the positive x-axis points to the right and the positive y-axis points up. The problem I have is with the labelling of axes.
What I've tried:
RegionPlot3D[0 <= z && z <= 1 - x - y && 0 <= y <= 1 - x , {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
Mesh -> All, PlotPoints -> 100, AxesLabel -> Automatic, LabelStyle -> Directive[Black, 12],
ViewPoint -> {0, 0, 5}, ViewAngle -> 0 Degree, PlotStyle -> Green]
The resulting green "triangle" looks like it should when viewed from the positive z-axis, but none of the axes are labeled.
RegionPlot3D[0 <= z && z <= 1 - x - y && 0 <= y <= 1 - x,
{x, 0, 1}, {y, 0, 1}, {z, 0, 1},
ViewPoint -> {0, 0, 5}, PlotStyle -> Green,
AxesEdge -> {{-1, 1}, {-1, 1}, None},
AxesLabel -> Automatic]

How to set the step of plotting by one of axes in Wolfram Mathematica

I have a data such as list of points x,y,z. I added interpolation by splines as
f = Interpolation[{#[[1 ;; 2]], #[[3]]} & /# data, Method -> "Spline"]
And after all I try to plot
`Show[Plot3D[f[x, y], {x, 10000, 10000000}, {y, 10, 50}, Mesh -> 15,
MeshFunctions -> {#3 &}, PlotRange -> {0, 0.0011},
PlotRangePadding -> {0.001, 0.0003}, PlotStyle -> Opacity[0.7],
ColorFunction -> "Rainbow",
AxesStyle -> {Black, Black, Black}],
Graphics3D[{Red, PointSize[.016], Point[data]}]]`
Can't post image.
I use such data as
data = {{10000, 10, 0.000000208191701}, {10000, 20, 0.000000416383402}, {10000, 30, 0.00000066886188}, {10000, 40,0.000000832854501}, {10000, 50, 0.000001040870809}, {100000, 10,0.000002081829313}, {100000, 20, 0.000004163483234}, {100000, 30,0.000006245400245}, {100000, 40, 0.000008327229558}, {100000, 50,0.000010409058871}, {1000000, 10, 0.000020818731618}, {1000000,20, 0.000041636761666}, {1000000, 30,
0.000062455405588}, {1000000, 40, 0.00008327361103}, {1000000, 50,
0.000104092254952},{10000000, 10, 0.000208475750285}, {10000000,
20, 0.000416951237469}, {10000000, 30,
0.000625426900044}, {10000000, 40, 0.000833902387228}, {10000000,
50, 0.001042377962108}}
And I have the question, how can I pull the graph in the Z axis by setting of other step of plotting?
I have changed the aspect ratio from the default, and added z-axis tick values.
You could simply use Ticks -> {Automatic, Automatic, {0, 0.0002, 0.0004, 0.0006, 0.0008, 0.001}} but I added some formatting. FindDivisions is useful for less straightforward cases.
Show[Plot3D[f[x, y], {x, 10000, 10000000}, {y, 10, 50}, Mesh -> 15,
MeshFunctions -> {#3 &}, PlotRange -> {0, 0.0011},
PlotRangePadding -> {0.001, 0.0003}, PlotStyle -> Opacity[0.7],
ColorFunction -> "Rainbow", AxesStyle -> {Black, Black, Black},
Ticks -> {Automatic, Automatic,
{#, NumberForm[#, {3, 4}]} & /# N#FindDivisions[{0, 0.001}, 5]},
AspectRatio -> 1, ImageSize -> 300],
Graphics3D[{Red, PointSize[.016], Point[data]}]]
Edit
Adding sub-ticks:-
Show[Plot3D[f[x, y], {x, 10000, 10000000}, {y, 10, 50}, Mesh -> 15,
MeshFunctions -> {#3 &}, PlotRange -> {0, 0.0011},
PlotRangePadding -> {0.001, 0.0003}, PlotStyle -> Opacity[0.7],
ColorFunction -> "Rainbow", AxesStyle -> {Black, Black, Black},
Ticks -> {Automatic, Automatic,
DeleteCases[
Flatten[{{#1, NumberForm[#1, {3, 4}]}, {#2, ""}, {#3, ""}, {#4, ""}} & ###
Partition[N#FindDivisions[{0, 0.001}, 20], 4, 4, {1, 1}, Null], 1],
{Null, _}]},
AspectRatio -> 1, ImageSize -> 300],
Graphics3D[{Red, PointSize[.016], Point[data]}]]
Adding Box Ratios
Show[Plot3D[f[x, y], {x, 10000, 10000000}, {y, 10, 50}, Mesh -> 15,
MeshFunctions -> {#3 &}, PlotRange -> {0, 0.0011},
PlotRangePadding -> {0.001, 0.0003}, PlotStyle -> Opacity[0.7],
ColorFunction -> "Rainbow", AxesStyle -> {Black, Black, Black},
Ticks -> {Automatic, Automatic,
DeleteCases[
Flatten[{{#1, NumberForm[#1, {3, 4}]}, {#2, ""}, {#3, ""}, {#4, ""}} & ###
Partition[N#FindDivisions[{0, 0.001}, 20], 4, 4, {1, 1}, Null], 1],
{Null, _}]}, AspectRatio -> 1, ImageSize -> 1200],
Graphics3D[{Red, PointSize[.016], Point[data]}],
BoxRatios -> {1, 1, 3},
BaseStyle -> FontSize -> 36]

Disk inside plot in mathematica

I have a question about using plot and disk together in one manipulate function in mathematica.
I have this piece of code right now:
Plot[h[t], {t, 0, ttot}, PlotRange -> {0, 30}]
Manipulate[
Plot[
h0 + v0*t - 1/2*g*(t)^2, {t, 0, 10},
PlotRange -> {{-1, 8}, {0, 11.5}}
],
{t, 0, ttot, 0.001}, {m, 0.001, 0.1, 0.001, ImageSize -> Tiny}, {v0,
0, 5, 0.01, ImageSize -> Tiny}, {h0, 0, 10, 0.01, ImageSize -> Tiny}
]
What I want to do is display a disk inside the plot representing a flying object (its position is on the curve, according to actual time and height). How do I do it?
You should show the definitions of the symbols you use : h[t], v0, ttot etc.
My understanding of what you are after :
trajectory[p0_, v0_, a_, t_] = p0 + v0 t - 1/2 a t^2;
x0 = 3;
v0y = 1;
g = 9.81;
ttot = 3;
Manipulate[ParametricPlot[trajectory[{x0, h0}, {v0x, v0y}, {0, g}, t], {t, 0, ttot}, Epilog -> {Disk[trajectory[{x0, h0}, {v0x, v0y}, {0, g}, tcurrent], 0.5]}, PlotRange -> All], {v0x, 0, 5, 0.01}, {h0, 0, 10, 0.01}, {tcurrent, 0, ttot, 0.01}]

"3d Grid" Inside the Box in Graphics3D

Please Consider :
cAxes = {{{0, 0, 0}, {0, 0, 1}}, {{0, 0, 0}, {0, 1, 0}}, {{0, 0,0}, {1, 0, 0}}};
Graphics3D[{Line /# cAxes}, Boxed -> False]
Is it possible to have Grids inside the Box ? I guess "3D Grid"
Here is a reworked version of what I believe Verbeia was attempting:
cAxes = {{{0, 0, 0}, {0, 0, 1}}, {{0, 0, 0}, {0, 1, 0}}, {{0, 0,
0}, {1, 0, 0}}};
a = Graphics3D[{Line /# cAxes}, Boxed -> False];
b = Graphics3D[{
GrayLevel[0.5],
Table[Line /# {{{x, y, 0}, {x, y, 1}},
{{x, 0, y}, {x, 1, y}},
{{0, x, y}, {1, x, y}}},
{x, 0, 1, 0.25},
{y, 0, 1, 0.25}
]
}];
Show[a, b]

Upgrade from Mathematica 5 to Mathematica 7

I am trying to upgrade some equations that currently are written against Mathematica 5 to get them to work in Mathematica 7.
F = Graphics[
ContourPlot[
x^2 + (2)*y^2 + (-1)*((1)/(3))*x, {x, -1, 1}, {y, -1, 1},
ContourShading -> False, ContourStyle -> {RGBColor[1, 0, 1]},
Contours -> 20, PlotPoints -> 100]];
G = ParametricPlot[{Cos[u], Sin[u]}, {u, 0, 2*Pi},
PlotStyle -> {RGBColor[0, 174/255, 239/255]}];
H = DeleteCases[F, {x_, y_} /; (x^2 + y^2 > 1), 5];
Show[{H, G}, AspectRatio -> Automatic, Frame -> False, Axes -> True,
AxesOrigin -> {0, 0}, AxesLabel -> {x, y}, Ticks -> None]
It should look like this:
, but id does look like this:
and it gives the following error:
Thread::tdlen: Objects of unequal length in
{{},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{}}+{{},<<21>>,{}}
cannot be combined. >>
and if you hover over the image you get the following in a tooltip:
The specified setting for the option GraphicsBoxOptions, PlotRange cannot be used.
Coordinate index X is out of range for the enclosing GraphicsComplex
there are a lot of those Coordinate ones all with different coordinates.
And the second one I'm having difficulty with is:
P1 = {{(5)/10*Cos[u]*Cos[v], (5)/10*Sin[u]*Cos[v], (5)/10*Sin[v]}, {u,
0, 2*Pi}, {v, -Pi/2, Pi/2}};
P2 = {{(5)/10*Cos[u], 0, (5)/10*Sin[u]}, {u, 0, 2*Pi}};
P3 = {{(5)/10*Cos[u], (5)/10*Sin[u], 0}, {u, 0, 2*Pi}};
P4 = {{0, (5)/10*Cos[u], (5)/10*Sin[u]}, {u, 0, 2*Pi}};
U = {P1, P2, P3, P4};
XL = {{-1, 1}, {-1, 1}, {-1, 1}};
XV = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
XS = {"x", "y", "z"};
f[a_, b_, c_] := {a, 1.1*b[[2]]*c};
g[a_, b_] := {(b*# &) /# a};
T = Text ### MapThread[f, {XS, XL, XV}];
A = Line ### MapThread[g, {XL, XV}];
F = (ParametricPlot3D[Evaluate[Evaluate ## #]][[1]] &) /# U;
OPT = {Boxed -> False, Axes -> False, BoxRatios -> {1, 1, 1}, PlotRange -> XL,
ViewPoint -> {2.4, 1.3, 2},
DisplayFunction ->
Identity};
L = {LightSources -> {{{0.1, 0, 1}, RGBColor[0.68, 0.88, 0.96]}}};
gr1 = (Show[Graphics3D[#], OPT, L] &) /# {{EdgeForm[], F}, {Dashing[{0.03, 0.03}],
GrayLevel[0.7], A}, {T}};
gr2 = DeleteCases[Graphics[Show[Graphics3D[{A, EdgeForm[], F}], OPT,
RenderAll -> False]], {__, _Polygon}, 3];
Show[{gr1, gr2}, AspectRatio -> Automatic]
This one should look like: , but does look like:
which and it gives these errors:
ParametricPlot3D::write: Tag Plus in x^2+y^2 is Protected. >>
Graphics3D::optx : Unknown option RenderAll
Graphics3D::optx : Unknown option LightSources
If I then remove the Unknown options, those errors disappear but it still looks wrong:
Also, if you hover over the last image in mathematica you get the following message repeated several times in a tooltip
Times is not a Graphics3D primitive or directive
Second one, great circles partly hidden, axes partly dashed:
r = 1.01/2; d = 1/(100 r);
v1 = Riffle[
Table[r { Cos[\[Phi]], Sin[\[Phi]], -d}, {\[Phi], 0, 2 \[Pi], (
2 \[Pi])/40.}],
Table[r { Cos[\[Phi]], Sin[\[Phi]], d}, {\[Phi], 0, 2 \[Pi], (
2 \[Pi])/40.}]];
v2 = Riffle[
Table[-r { Cos[\[Phi]], -d, Sin[\[Phi]]}, {\[Phi], 0, 2 \[Pi], (
2 \[Pi])/40.}],
Table[-r { Cos[\[Phi]], d, Sin[\[Phi]]}, {\[Phi], 0, 2 \[Pi], (
2 \[Pi])/40.}]];
v3 = Riffle[
Table[r { -d, Cos[\[Phi]], Sin[\[Phi]]}, {\[Phi], 0, 2 \[Pi], (
2 \[Pi])/40.}],
Table[r { d, Cos[\[Phi]], Sin[\[Phi]]}, {\[Phi], 0, 2 \[Pi], (
2 \[Pi])/40.}]];
lx = {{{1, 0, 0}, {2, 0, 0}}}/2;
ly = {{{0, 1, 0}, {0, 2, 0}}}/2;
lz = {{{0, 0, 1}, {0, 0, 2}}}/2;
A2 = Line ### {lx, ly, lz, -lx, -ly, -lz};
Graphics3D[
{
FaceForm[None, Black], EdgeForm[],
GraphicsComplex[#,
Table[Polygon[Mod[{i, i + 1, i + 3, i + 2}, Length[v], 1]], {i,
1, Length[v] - 1, 2}]] & /# {v1, v2, v3}, {Opacity[0.75],
RGBColor[0.68`, 0.88`, 0.96`], Sphere[{0, 0, 0}, 1/2]},
{Dashing[{0.02, 0.02}], Black, A}, T, A2
},
Boxed -> False,
Lighting -> {{"Directional", RGBColor[0.68`, 0.88`, 0.96`],
ImageScaled#{0.1, 0, 1}}}, BoxRatios -> {1, 1, 1},
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
BaseStyle -> FontSize -> 14, ViewPoint -> {2.4`, 1.3`, 2},
ViewVertical -> {0, 0, 1}
]
It is a little hard to tell from the picture what you want for the second graphic. Please try this and tell me what is right and what is lacking.
P1 = {{(5)/10*Cos[u]*Cos[v], (5)/10*Sin[u]*Cos[v], (5)/10*Sin[v]}, {u,
0, 2*Pi}, {v, -Pi/2, Pi/2}};
P2 = {{(5)/10*Cos[u], 0, (5)/10*Sin[u]}, {u, 0, 2*Pi}};
P3 = {{(5)/10*Cos[u], (5)/10*Sin[u], 0}, {u, 0, 2*Pi}};
P4 = {{0, (5)/10*Cos[u], (5)/10*Sin[u]}, {u, 0, 2*Pi}};
U = {P1, P2, P3, P4};
XL = {{-1, 1}, {-1, 1}, {-1, 1}};
XV = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
XS = {"x", "y", "z"};
f[a_, b_, c_] := {a, 1.1*b[[2]]*c};
g[a_, b_] := {(b*# &) /# a};
T = Text ### MapThread[f, {XS, XL, XV}];
A = Line ### MapThread[g, {XL, XV}];
F = ParametricPlot3D[##, Mesh -> False][[1]] & ### U;
OPT = {Boxed -> False, Axes -> False, BoxRatios -> {1, 1, 1},
PlotRange -> XL, ViewPoint -> {2.4, 1.3, 2}};
L = Lighting -> {{"Directional",
RGBColor[0.68, 0.88, 0.96], {{5, 5, 4}, {5, 5, 0}}}};
gr1 = Graphics3D[#, OPT, L] & /# {{Opacity[0.5], F},
{Dashing[{0.03, 0.03}], GrayLevel[0.7], A},
{T}};
Show[gr1]
Here is another take that may be closer to the original. You lose the v7 ability to rotate the graphic with this.
gr1 = Rasterize[Graphics3D[#, OPT, L],
Background -> None] & /# {F, {Dashing[{0.03, 0.03}],
GrayLevel[0.7], A}, T};
Show[gr1]
First one:
ContourPlot[x^2 + (2)*y^2 + (-1)*((1)/(3))*x, {x, -1, 1}, {y, -1, 1},
ContourShading -> False, ContourStyle -> {RGBColor[1, 0, 1]},
Contours -> 20, RegionFunction -> (#1^2 + #2^2 <= 1 &),
BoundaryStyle -> Blue]
[Edit]
Second one, using the given values for A and T:
Show[
ParametricPlot3D[{(5)/10*Cos[u]*Cos[v], (5)/10*Sin[u]*Cos[v], (5)/10*
Sin[v]}, {u, 0, 2*Pi}, {v, -Pi/2, Pi/2},
MeshFunctions -> {#1 &, #2 &, #3 &}, PlotStyle -> Opacity[0.75],
Mesh -> {{0}, {0}, {0}}, MeshStyle -> Black, BoundaryStyle -> Black,
Boxed -> False, Axes -> False, BoxRatios -> {1, 1, 1},
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
ViewPoint -> {2.4`, 1.3`, 2},
Lighting -> {{"Directional", RGBColor[0.68`, 0.88`, 0.96`],
ImageScaled#{0.1, 0, 1}}}],
Graphics3D[{{Dashing[{0.03, 0.03}], Black, A}, {T}}]
]
I think the axes will need to be done as separate interior/exterior segments.
The great circles show through in this version; preventing that will require drawn partial curves instead of mesh lines, if that's required.

Resources