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}]
Related
I can plot the curve corresponding to an implicit equation:
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1}]
But I cannot find a way to color the contour line depending on the location of the point. More precisely, I want to color the curve in 2 colors, depending on whether x² + y² < k or not.
I looked into ColorFunction but this is only for coloring the region between the contour lines.
And I was not able to get ContourStyle to accept a location-dependent expression.
you could use RegionFunction to split the plot in two:
Show[{
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 < .5],
ContourStyle -> Red],
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 >= .5],
ContourStyle -> Green]
}]
Maybe something like this
pl = ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1}]
points = pl[[1, 1]];
colorf[{x_, y_}] := ColorData["Rainbow"][Rescale[x, {-1, 1}]]
pl /. {Line[a_] :> {Line[a, VertexColors -> colorf /# points[[a]]]}}
which produces
This does not provide a direct solution to your question but I believe it is of interest.
It is possible to color a line progressively from within ContourPlot using what I think is an undocumented format, namely a Function that surrounds the Line object. Internally this is similar to what Heike did, but her solution uses the vertex numbers to then find the matching coordinates allowing styling by spacial position, rather than position along the line.
ContourPlot[
x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
BaseStyle -> {12, Thickness[0.01]},
ContourStyle ->
(Line[#, VertexColors -> ColorData["DeepSeaColors"] /# Rescale##] & ## # &)
]
For some of the less adept, less information is more. Time was wasted browsing for a way to set the color of contour lines until I chanced onto Roelig's edited answer. I just needed ContourStyle[].
Show[{ContourPlot[
x^2 + 2 x y Tan[2 # ] - y^2 == 1, {x, -3, 3}, {y, -3.2, 3.2},
ContourStyle -> Green] & /# Range[-Pi/4, Pi/4, .1]},
Background -> Black]
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]
}]
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]
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]
How can I make it such that plotting the following function
ListPointPlot3D[points, PlotStyle -> PointSize[0.05]];
the points I see are green or yellow, for instance, instead of the typical dark blue ones?
Thanks
Use Directive to combine styles, ie
ListPointPlot3D[points, PlotStyle -> Directive[{PointSize[0.05], Green}]]
Edit I give you below two possible solutions in a context related to your previous question. Nevertheless, please note that #Yaroslav's code is much better.
f[x_, y_] := x^2 + y^2;
t = Graphics3D[{PointSize[Large], Red, Point#
Flatten[Table[{x, y, f[x, y]}, {x, 0, 10, 1}, {y, 1, 2, 1}], 1]}];
b = Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10},
ColorFunction -> "MintColors"];
Show[{b, t}]
Or
f[x_, y_] := x^2 + y^2;
points = Flatten[Table[{x, y, f[x, y]}, {x, 0, 10, 1}, {y, 1, 2, 1}],
1];
a = ListPointPlot3D[points,
PlotStyle -> Table[{Red, PointSize[0.05]}, {Length#t}]];
b = Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10},
ColorFunction -> "MintColors"];
Show[{b, a}]
Sometimes I find the following approach useful, as it allows me to
manipulate the plot symbol (PlotMarkers does not seem to work with ListPointPlot3D,
at least in Mathematica 7) [originally suggested by Jens-Peer Kuska]:
ListPointPlot3D[{{1,1,1},{2,2,2},{3,3,3}}]/.Point[xy_]:>(Style[Text["\[FilledUpTriangle]",#],Red,FontSize-> 20]&/#xy)