I want to generate a plot like the following
I am not sure how to generate a shading even though I can get the frame done. I'd like to know the general approach to shade certain areas in a plot in Mathematica. Please help. Thank you.
Perhaps you are looking for RegionPlot?
RegionPlot[(-1 + x)^2 + (-1 + y)^2 < 1 &&
x^2 + (-1 + y)^2 < 1 && (-1 + x)^2 + y^2 < 1 && x^2 + y^2 < 1,
{x, 0, 1}, {y, 0, 1}]
Note the use of op_ in the following (only one set of equations for the curves and the intersection!):
t[op_] :=Reduce[op[(x - #[[1]])^2 + (y - #[[2]])^2, 1], y] & /# Tuples[{0, 1}, 2]
tx = Texture[Binarize#RandomImage[NormalDistribution[1, .005], 1000 {1, 1}]];
Show[{
Plot[y /. ToRules /# #, {x, 0, 1}, PlotRange -> {{0, 1}, {0, 1}}] &# t[Equal],
RegionPlot[And ## #, {x, 0, 1}, {y, 0, 1}, PlotStyle -> tx] &# t[Less]},
Frame->True,AspectRatio->1,FrameStyle->Directive[Blue, Thick],FrameTicks->None]
If, for any particular reason, you want the dotted effect in your picture, you can achieve this like so:
pts = RandomReal[{0, 1}, {10000, 2}];
pts = Select[pts,
And ## Table[Norm[# - p] < 1, {p,
{{0, 0}, {1, 0}, {1, 1}, {0, 1}}}] &];
Graphics[{Thick,
Line[{{0, 0}, {1, 0}, {1, 1}, {0, 1}, {0, 0}}],
Circle[{0, 0}, 1, {0, Pi/2}],
Circle[{1, 0}, 1, {Pi/2, Pi}],
Circle[{1, 1}, 1, {Pi, 3 Pi/2}],
Circle[{0, 1}, 1, {3 Pi/2, 2 Pi}],
PointSize[Small], Point[pts]
}]
Related
In the code below, If I chenage (4/([Zeta]*[Omega])) to, say 20, nothing is plotted. Why?
If I remove the two sliders at the beginning, nothing is plotted
ClearAll[\[Zeta], \[Omega]]
{Slider[ Dynamic[\[Zeta]], {0.1, 1.4, 0.1}], Dynamic[\[Zeta]]}
{Slider[ Dynamic[\[Omega]], {1, 5, 0.1}], Dynamic[\[Omega]]}
tf[\[Omega]_, \[Zeta]_] :=
TransferFunctionModel[\[Omega]^2/(s^2 +
2 \[Zeta] \[Omega] s + \[Omega]^2), s]
f[t_] = OutputResponse[tf[\[Omega], \[Zeta]], UnitStep[t], t];
Manipulate[
Plot[f[t], {t, 0, (4/(\[Zeta]*\[Omega]))},
PlotRange -> {{0, (4/(\[Zeta]*\[Omega]))}, {0, 2}}], {{\[Zeta],
0.2}, 0.1, 1.4}, {{\[Omega], 1}, 0.5, 4}
]
tf[o_, z_] := TransferFunctionModel[o^2/(s^2 + 2 z o s + o^2), s]
f[t_, o_, z_] = OutputResponse[tf[o, z], UnitStep[t], t];
Manipulate[Plot[f[t, o, z], {t, 0, 20}, PlotRange -> {0, 2}],
{{z, 0.2}, 0.1, 1.4}, {{o, 1}, 0.5, 4}]
Can I plot and deal with implicit functions in Mathematica?
for example :-
x^3 + y^3 = 6xy
Can I plot a function like this?
ContourPlot[x^3 + y^3 == 6*x*y, {x, -2.7, 5.7}, {y, -7.5, 5}]
Two comments:
Note the double equals sign and the multiplication symbols.
You can find this exact input via the WolframAlpha interface. This interface is more forgiving and accepts your input almost exactly - although, I did need to specify that I wanted some type of plot.
Yes, using ContourPlot.
And it's even possible to plot the text x^3 + y^3 = 6xy along its own curve, by replacing the Line primitive with several Text primitives:
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black, PlotPoints -> 7, MaxRecursion -> 1, ImageSize -> 500] /.
{
Line[s_] :>
Map[
Text[Style["x^3+y^3 = 6xy", 16, Hue[RandomReal[]]], #, {0, 0}, {1, 1}] &,
s]
}
Or you can animate the equation along the curve, like so:
res = Table[ Normal[
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black,
ImageSize -> 600]] /.
{Line[s_] :> {Line[s],
Text[Style["x^3+y^3 = 6xy", 16, Red], s[[k]], {0, 0},
s[[k + 1]] - s[[k]]]}},
{k, 1, 448, 3}];
ListAnimate[res]
I'm guessing this is what you need:
http://reference.wolfram.com/mathematica/Compatibility/tutorial/Graphics/ImplicitPlot.html
ContourPlot[x^3 + y^3 == 6 x*y, {x, -10, 10}, {y, -10, 10}]
I want to look at both the real and imaginary parts of some functions that depend on a parameter n. Individually (with set values of n), I get perfectly nice graphs, but when putting them in a Manipulate they become very small.
Here is the exact code I'm using; remove the manipulate and the graphs display at a good size, but with it they are too small to be legible.
Manipulate[
Plot3D[Im[Sqrt[-1 + (x + I y)^2 n]], {x, -2, 2}, {y, -1, 1},
AxesLabel -> Automatic]
Plot3D[Re[Sqrt[-1 + (x + I y)^2 n]], {x, -2, 2}, {y, -2, 2},
AxesLabel -> Automatic]
, {n, 1, 10, 1}]
Why is it doing this, and how can I fix it?
Manipulate[
Row[{
Plot3D[Im[Sqrt[-1 + (x + I y)^2 n]], {x, -2, 2}, {y, -1, 1},
AxesLabel -> Automatic, ImageSize -> 300] ,
Plot3D[Re[Sqrt[-1 + (x + I y)^2 n]], {x, -2, 2}, {y, -2, 2},
AxesLabel -> Automatic, ImageSize -> 300]}],
{n, 1, 10, 1}]
Edit
Remember that you may also do something like:
a = Sequence ##{{x, -2, 2}, {y, -1, 1}, AxesLabel-> Automatic, ImageSize-> 200};
Manipulate[
Row[{
Plot3D[Im[Sqrt[-1 + (x + I y)^2 n]], Evaluate#a],
Plot3D[Re[Sqrt[-1 + (x + I y)^2 n]], Evaluate#a]}],
{n, 1, 10, 1},
PreserveImageOptions -> False]
Why doesn't this work?
I have bypassed this before but i can't remember how i did it, and I never went on to figure out why this type of inputs didn't work. About time to get to know it!
For those who cant see the pic:
RegionPlot3D[
x^2 + 2 y^2 - 2 z^2 = 1 && -1 <= z <= 1, {x, -5, 5}, {y, -5,
5}, {z, -1, 1}]
Set::write: "Tag Plus in -2.+25.+50. is Protected"
And then there is just an empty cube without my surface.
If z is limited by other surfaces you could go like this:
RegionPlot3D[
x^2 + 2 y^2 - 2 z^2 < 1 && z < x + 2 y && z^2 < .5,
{x, -2, 2}, {y, -2, 2}, {z, -1, 1},
PlotPoints -> 50, MeshFunctions -> {Function[{x, y, z}, z]},
PlotStyle -> Directive[Red, Opacity[0.8]]]
Or with ContourPlot:
ContourPlot3D[
x^2 + 2 y^2 - 2 z^2 == 1,
{x, -2, 2}, {y, -2, 2}, {z, -1, 1},
RegionFunction -> Function[{x, y, z}, z < x + 2 y && z^2 < .5],
PlotPoints -> 50, MeshFunctions -> {Function[{x, y, z}, z]},
ContourStyle -> Directive[Red, Opacity[0.8]]]]
Try this
RegionPlot3D[x^2 + 2 y^2 - 2 z^2 < 1,
{x, -5, 5}, {y, -5, 5}, {z, -1, 1}]
Or, if you just want the surface
ContourPlot3D[x^2 + 2 y^2 - 2 z^2 == 1,
{x, -5, 5}, {y, -5, 5}, {z, -1, 1}]
Note the double equals sign, rather than the single equals sign.
i'd like to have something like this
w[w1_] :=
NDSolve[{y''[x] + y[x] == 2, y[0] == w1, y'[0] == 0}, y, {x, 0, 30}]
this seems like it works better but i think i'm missing smtn
w := NDSolve[{y''[x] + y[x] == 2, y[0] == w1, y'[0] == 0},
y, {x, 0, 30}]
w2 = Table[y[x] /. w, {w1, 0.0, 1.0, 0.5}]
because when i try to make a table, it doesn't work:
Table[Evaluate[y[x] /. w2], {x, 10, 30, 10}]
i get an error:
ReplaceAll::reps: {<<1>>[x]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>
ps: is there a better place to ask questions like that? mathematica doesn't have supported forums and only has mathGroup e-mail list. it would be nice if stackoverflow would have more specific mathematica tags like simplify, ndsolve, plot manipulation
There are a lot of ways to do that. One is:
w[w1_] := NDSolve[{y''[x] + y[x] == 2,
y'[0] == 0}, y[0] == w1,
y[x], {x, 0, 30}];
Table[Table[{w1,x,y[x] /. w[w1]}, {w1, 0., 1.0, 0.5}]/. x -> u, {u, 10, 30, 10}]
Output:
{{{0., 10, {3.67814}}, {0.5, 10, {3.25861}}, {1.,10, {2.83907}}},
{{0., 20, {1.18384}}, {0.5, 20, {1.38788}}, {1.,20, {1.59192}}},
{{0., 30, {1.6915}}, {0.5, 30, {1.76862}}, {1.,30, {1.84575}}}}
I see you already chose an answer, but I want to toss this solution for families of linear equations up. Specifically, this is to model a slight variation on Lotka-Volterra.
(*Put everything in a module to scope x and y correctly.*)
Module[{x, y},
(*Build a function to wrap NDSolve, and pass it
the initial conditions and range.*)
soln[iCond_, tRange_, scenario_] :=
NDSolve[{
x'[t] == -scenario[[1]] x[t] + scenario[[2]] x[t]*y[t],
y'[t] == (scenario[[3]] - scenario[[4]]*y[t]) -
scenario[[5]] x[t]*y[t],
x[0] == iCond[[1]],
y[0] == iCond[[2]]
},
{x[t], y[t]},
{t, tRange[[1]], tRange[[2]]}
];
(*Build a plot generator*)
GeneratePlot[{iCond_, tRange_, scen_,
window_}] :=
(*Find a way to catch errors and perturb iCond*)
ParametricPlot[
Evaluate[{x[t], y[t]} /. soln[iCond, tRange, scen]],
{t, tRange[[1]], tRange[[2]]},
PlotRange -> window,
PlotStyle -> Thin, LabelStyle -> Medium
];
(*Call the plot generator with different starting conditions*)
graph[scenario_, tRange_, window_, points_] :=
{plots = {};
istep = (window[[1, 2]] - window[[1, 1]])/(points[[1]]+1);
jstep = (window[[2, 2]] - window[[2, 1]])/(points[[2]]+1);
Do[Do[
AppendTo[plots, {{i, j}, tRange, scenario, window}]
, {j, window[[2, 1]] + jstep, window[[2, 2]] - jstep, jstep}
], {i, window[[1, 1]] + istep, window[[1, 2]] - istep, istep}];
Map[GeneratePlot, plots]
}
]
]
We can then use Animate (or table, but animate is awesome)
tRange = {0, 4};
window = {{0, 8}, {0, 6}};
points = {5, 5}
Animate[Show[graph[{3, 1, 8, 2, 0.5},
{0, t}, window, points]], {t, 0.01, 5},
AnimationRunning -> False]