I have a question with labeling a plot in Mathematica. I will describe my problem.
I have a function like this.
y = 4 x / L + 2
I want to draw a graph of y vs. x. And also,I have
L={10,20,30,40}
When I write a code like below,
Plot[y, {x, 0, 100},
ImageSize -> Scaled[1.0], PlotLabel -> Style["y vs X ", FontSize -> 18]]
I have four different plots in the same graph. I want to know how to label each plot with their relavant L value.
You can label the lines as you like using this method, based on my earlier post here. After labelling, the plot without dynamic content can be found set to plainplot.
It works by turning each line into a self-labelling button. You can modify labels for different labels.
l = {10, 20, 30, 40};
y[x_, s_] := 4 x/s + 2
plot = Plot[Evaluate#Table[y[x, u], {u, l}], {x, 0, 100},
PlotLabel -> Style["y vs X ", FontSize -> 18]];
pos = Position[plot, _Line];
Array[(line[#] = plot[[Sequence ## pos[[#]]]]) &, Length#l];
AddLabel[label_] := Module[{},
AppendTo[plot[[1]], Inset[Framed[label, Background -> White], pt]];
(* Removing buttons for final plot *)
plainplot = plot;
Array[
(plainplot[[Sequence ## pos[[#]]]] =
plainplot[[Sequence ## Append[pos[[#]], 1]]]) &, Length#l]]
labels = ToString /# l;
Array[
(plot[[Sequence ## pos[[#]]]] =
Button[line[#], AddLabel[labels[[#]]]]) &, Length#l];
Dynamic[EventHandler[plot,
"MouseDown" :> (pt = MousePosition["Graphics"])]]
l = {10, 20, 30, 40}
y[x_, s_] := 4 x/s + 2
<< PlotLegends`
Plot[Evaluate#Table[y[x, u], {u, l}], {x, 0, 100},
ImageSize -> Scaled[1.0],
PlotLabel -> Style["y vs X ", FontSize -> 18],
PlotLegend -> ("L = " <> ToString## & /# l)]
Related
Suppose I have a function like this.
u = (1 / 4 Sin[t] (1 - r^2)) ;
Plot[u,{r,0,1}]
The above command will plot "U" on Y-axis and "r" on X-axis, But I want it in the reverse direction. "U" on X-axis and "r" on Y-axis.
How to do this, I'm new to Mathematica.
Many thanks for considering my request.
You can tabulate the results using Table and reverse each data point
Clear[t, u]
u[r_] := (1/4 Sin[t] (1 - r^2));
t = 1.57;
ru = ListLinePlot[table = Table[{r, u[r]}, {r, 0, 1, 0.01}],
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {r, u}];
ur = ListLinePlot[Reverse /# table,
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {u, r}];
GraphicsRow[{ru, ur}]
Or you can generate an inverse function to use in Plot
Clear[t, u]
u[r_] := (1/4 Sin[t] (1 - r^2));
t = 1.57;
plotru = Plot[u[r], {r, 0, 1},
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {r, u}];
Clear[t, u]
v = Quiet[InverseFunction[(1/4 Sin[t] (1 - #^2)) &]];
t = 1.57;
plotur = Plot[-v[x], {x, 0, 0.25},
AspectRatio -> 1, ImageSize -> 200, AxesLabel -> {u, r}];
GraphicsRow[{plotru, plotur}]
I found the answer to this Question using the ParametricPlot command
ParametricPlot[{(1 - r^2) /. r -> Abs[r], r}, {r, -Pi, Pi}]
How is it possible to extend the scope of the slider variable beyong the 'Manipulate' function? In this coding 'n' = 10 before and after the 'Manipulate' function but can vary between -10 and +10 in the plot routine.
n = 10;
Manipulate[
Plot[Sin[n*x], {x, -5, 5}], {n, -10, 10, 1, Appearance -> "Labeled"}]
Print["n = ", n]
Thank you in advance for all contributors.
Norman
Use another variable name for the control variable in the Manipulate.
n = 10;
Manipulate[
Plot[Sin[(n = m)*x], {x, -5, 5}], {{m, n}, -10, 10, 1, Appearance -> "Labeled"}]
Print["n = ", Dynamic[n]]
I have two functions:
y = x - x^3and
x = y^3 - y
I need to plot them both in one plane, I wonder how to achieve this with Mathematica?
Thanks
One way is to use ContourPlot
let's Wrap it in Manipulate to make it more easy to adjust
Manipulate[
With[{f1 = y == x - x^3, f2 = x == y^3 - y},
ContourPlot[{f1, f2}, {x, -lim, lim}, {y, -lim, lim},
Frame -> True,
FrameLabel -> {{y, None}, {x, {f1, f2}}},
ImagePadding -> 30,
GridLines -> Automatic,
GridLinesStyle -> Directive[Thickness[.001], LightGray]]
],
{{lim, 3, "limit"}, .1, 10, .1, Appearance -> "Labeled"}
]
I have a dataset with labels which I would like to plot with points colored according to their label. Is there a simple way how to get current line numer inside plot, so that I can determine which category does the point belong to?
I understood that x,y,z are the coordinates of plotted data, but it doesn't help for the external labels.
This is quite ugly and it works just on sorted dataset with regular distribution.
data = Import["http://ftp.ics.uci.edu/pub/machine-learning-databases/iris/iris.data"];
data = Drop[data, -1]; (*there one extra line at the end*)
inData = data[[All, 1 ;; 4]];
labels = data[[All, 5]];
ListPlot3D[inData,
ColorFunction ->
Function[{x, y, z},
If[y < 0.33, RGBColor[1, 1, 0.],
If[y < 0.66, RGBColor[1, 0, 0.], RGBColor[1, 0, 1]]
]
]
]
Expected result:
Suppose that points is the lists of coordinates and labels a list of the corresponding labels so for example
points = Flatten[Table[{i, j, Sin[i j]},
{i, 0, Pi, Pi/20}, {j, 0, Pi, Pi/10}], 1];
labels = RandomChoice[{"label a", "label b", "label c"}, Length[points]];
Each label corresponds to a colour which I'm writing as a list of rules, e.g.
rules = {"label a" -> RGBColor[1, 1, 0],
"label b" -> RGBColor[1, 0, 0], "label c" -> RGBColor[1, 0, 1]};
Then the points can be plotted in the colour corresponding to their label as follows
ListPointPlot3D[Pick[points, labels, #] & /# Union[labels],
PlotStyle -> Union[labels] /. rules]
Edit
To colour individual points in a ListPlot3D you can use VertexColors, for example
ListPlot3D[points, VertexColors -> labels /. rules, Mesh -> False]
For Example:
(* Build the labeled structure and take a random permutation*)
f[x_, y_] = Sqrt[100 - x x - y y];
l = RandomSample#Flatten[{Table[{{"Lower", {x, y, f[x, y] - 5}},
{"Upper", {x, y, 5 - f[x, y]}}},
{x, -5, 5, .1}, {y, -5, 5, .1}]}, 3];
(*Plot*)
Graphics3D[
Riffle[l[[All, 1]] /. {"Lower" -> Red, "Upper" -> Green},
Point /# l[[All, 2]]], Axes -> True]
I am looking to plot something like the whispering gallery modes -- a 2D cylindrically symmetric plot in polar coordinates. Something like this:
I found the following code snippet in Trott's symbolics guidebook. Tried running it on a very small data set; it ate 4 GB of memory and hosed my kernel:
(* add points to get smooth curves *)
addPoints[lp_][points_, \[Delta]\[CurlyEpsilon]_] :=
Module[{n, l}, Join ## (Function[pair,
If[(* additional points needed? *)
(l = Sqrt[#. #]&[Subtract ## pair]) < \[Delta]\[CurlyEpsilon], pair,
n = Floor[l/\[Delta]\[CurlyEpsilon]] + 1;
Table[# + i/n (#2 - #1), {i, 0, n - 1}]& ## pair]] /#
Partition[If[lp === Polygon,
Append[#, First[#]], #]&[points], 2, 1])]
(* Make the plot circular *)
With[{\[Delta]\[CurlyEpsilon] = 0.1, R = 10},
Show[{gr /. (lp : (Polygon | Line))[l_] :>
lp[{#2 Cos[#1], #2 Sin[#1]} & ###(* add points *)
addPoints[lp][l, \[Delta]\[CurlyEpsilon]]],
Graphics[{Thickness[0.01], GrayLevel[0], Circle[{0, 0}, R]}]},
DisplayFunction -> $DisplayFunction, Frame -> False]]
Here, gr is a rectangular 2D ListContourPlot, generated using something like this (for example):
data = With[{eth = 2, er = 2, wc = 1, m = 4},
Table[Re[
BesselJ[(Sqrt[eth] m)/Sqrt[er], Sqrt[eth] r wc] Exp[
I m phi]], {r, 0, 10, .2}, {phi, 0, 2 Pi, 0.1}]];
gr = ListContourPlot[data, Contours -> 50, ContourLines -> False,
DataRange -> {{0, 2 Pi}, {0, 10}}, DisplayFunction -> Identity,
ContourStyle -> {Thickness[0.002]}, PlotRange -> All,
ColorFunctionScaling -> False]
Is there a straightforward way to do cylindrical plots like this?.. I find it hard to believe that I would have to turn to Matlab for my curvilinear coordinate needs :)
Previous snippets deleted, since this is clearly the best answer I came up with:
With[{eth = 2, er = 2, wc = 1, m = 4},
ContourPlot[
Re[BesselJ[(Sqrt[eth] m)/Sqrt[er], Sqrt[eth] r wc] Exp[I phi m]]/.
{r ->Norm[{x, y}], phi ->ArcTan[x, y]},
{x, -10, 10}, {y, -10, 10},
Contours -> 50, ContourLines -> False,
RegionFunction -> (#1^2 + #2^2 < 100 &),
ColorFunction -> "SunsetColors"
]
]
Edit
Replacing ContourPlot by Plot3D and removing the unsupported options you get:
This is a relatively straightforward problem. The key is that if you can parametrize it, you can plot it. According to the documentation both ListContourPlot and ListDensityPlot accept data in two forms: an array of height values or a list of coordinates plus function value ({{x, y, f} ..}). The second form is easier to deal with, such that even if your data is in the first form, we'll transform it into the second form.
Simply, to transform data of the form {{r, t, f} ..} into data of the form {{x, y, f} ..} you doN[{#[[1]] Cos[ #[[2]] ], #[[1]] Sin[ #[[2]] ], #[[3]]}]& /# data, when applied to data taken from BesselJ[1, r/2] Cos[3 t] you get
What about when you just have an array of data, like this guy? In that case, you have a 2D array where each point in the array has known location, and in order to plot it, you have to turn it into the second form. I'm partial to MapIndexed, but there are other ways of doing it. Let's say your data is stored in an array where the rows correspond to the radial coordinate and the columns are the angular coordinate. Then to transform it, I'd use
R = 0.01; (*radial increment*)
T = 0.05 Pi; (*angular increment*)
xformed = MapIndexed[
With[{r = #2[[1]]*R, t = #2[[1]]*t, f = #1},
{r Cos[t], r Sin[t], f}]&, data, {2}]//Flatten[#,1]&
which gives the same result.
If you have an analytic solution, then you need to transform it to Cartesian coordinates, like above, but you use replacement rules, instead. For instance,
ContourPlot[ Evaluate[
BesselJ[1, r/2]*Cos[3 t ] /. {r -> Sqrt[x^2 + y^2], t -> ArcTan[x, y]}],
{x, -5, 5}, {y, -5, 5}, PlotPoints -> 50,
ColorFunction -> ColorData["DarkRainbow"], Contours -> 25]
gives
Two things to note: 1) Evaluate is needed to ensure that the replacement is performed correctly, and 2) ArcTan[x, y] takes into account the quadrant that the point {x,y} is found in.