Related
I get this error for the Show method, why? :/
sol = First#
NDSolve[{eq1ad, eq2ad, eqrad} U CondizioniIniziali, {q1, q2,
qr}, {t, 0, T}]
p1 = ParametricPlot3D[
{xE, yE, zE} /. sol,
{t, 0, T},
AxesLabel -> {"x[t]", "y[t]", "z[t]"},
BoxRatios -> {1, 1, 1},
PlotStyle -> Red
]
Manipulate[
Show[
p1,
ListLinePlot[
{{0, 0, 0}, {xB, yB, zB}, {xE, yE, zE}} /. sol /. t -> time,
PlotStyle -> {Thick, Red}
]
],
{time, 0, T}
]
Is it maybe because I can't combine a ParametricPlot3d with Show?
I think you are trying to combine a 2D ListLinePlot with a 3D ParametricPlot3D. Reading the documentation for ListLinePlot seems to show that it only accepts 2D points, not 3D points.
You might be able to adapt something like this
T=2;
p1 = ParametricPlot3D[{Sin[t],Cos[t],t^2}, {t,0,T}];
Show[p1, Graphics3D[ Line[{{0, 0, 0}, {1/2,1/2,2}, {1/3, 1/3,3}}]]]
which can turn a list of 3D points into a Line into a Graphics3D and then combine that your ParametricPlot3D
I would very much appreciate your help on my problem.
I would like to use the same color function that applies to the plot of data1 when plotting data2.
For example:
data1 = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
ListPointPlot3D[data1, PlotStyle -> PointSize[0.02],
ColorFunction -> Function[{x, y, z}, RGBColor[x, y, z]]]
and next I wish to plot another data (of same dimensions) using the previous colors in the same exact order (there is an unknown function transforming data1 to data2):
data2 = {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}};
ListPointPlot3D[data2, PlotStyle -> PointSize[0.02],
ColorFunction -> Function[{x, y, z}, fun[x, y, z]]]
but for example a straightforward trial as follows will not work (although fun[] as such does work):
fun[r_, g_, b_] :=Table[RGBColor[data1[[i]]], {i,
Length[data1]}][[Position[data2, {r, g, b}][[1, 1]]]]
The gotcha in this is that ListPointPlot3D takes your integer data and converts to floats which it passes to your ColorFunction, so if you define your color function for discrete integers it fails to match the floats. Try this.. (Your approach may work as well if you work with real data )
data1 = N#{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
cfun1[x_, y_, z_] := RGBColor[x, y, z]
ListPointPlot3D[data1, PlotStyle -> PointSize[0.02],
ColorFunction -> cfun1]
data2 = N#{{1, 1, 0}, {1, 0, 1}, {0, 1, 1}};
MapThread[ (cfun2[#2[[1]], #2[[2]], #2[[3]]] = cfun1 ## #1) & ,
{data1, data2}]
ListPointPlot3D[data2, PlotStyle -> PointSize[0.02],
ColorFunction -> cfun2]
A bit of an aside, but you likely would be better off working with graphics primitives, which would look something like this:
colors = cfun1 /# data1;
Graphics3D#MapThread[ {#1, Point##2} & , {colors, data1} ]
Graphics3D#MapThread[ {#1, Point##2} & , {colors, data2} ]
Use the colours from data1 in the PlotStyle option of the data2 plot. The list of directives in the PlotStyle refer to each data series so you have to make each point its own data series. I also take it that the values may not be between zero and one so rescale them for data2's use of RGBColor.
ListPointPlot3D[data1, PlotStyle -> PointSize[0.02],
ColorFunction -> Function[{x, y, z}, RGBColor[x, y, z]]]
rs = MinMax /# Transpose#data1;
ListPointPlot3D[List /# data2,
PlotStyle -> ({PointSize[0.02], RGBColor[Quiet#Thread[Rescale[#, rs]]]} & /# data1)]
Hope this helps.
So I have a set of bounded diophantine equations that specify lines on the plane. I want to make mathematica plot the intersection of two of these equations so I can see what they look like.
So far I have something like:
Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers]
which returns some structure like:
{{x -> -2, y -> -4}, {x -> -1, y -> -3}, {x -> -1, y -> -2}, {x -> 0,
y -> -1}}
but how can I now make mathematica plot this so I can see the resulting shape. Preferably I would like the plot to consider every 'point' to be a 1x1 square.
Also, I wonder if there is a better way to do such things. Thanks.
Define the data you wish to plot by transforming the list Solve[] returns. This can done as
data = {x, y} /. Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers]
More generally, you can make Solve return the solution in a list format (rather than as a set of rules) using the following trick:
data = Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers] /. Rule[a_,b_]->b
For plotting, among many alternatives, you can use ListPlot as
ListPlot[data, PlotMarkers -> {Style["\[FilledSquare]", FontSize -> 16]}]
to get the following output
You can further refine it using many styling and other options of ListPlot. For example, you can join the points
ListPlot[data, PlotMarkers -> {Style["\[FilledSquare]", FontSize -> 16]},
Joined -> True]
to get
EDIT: To play with the marker placement and size there are several alternatives. Using ListPlot you can get what you need in either of the two ways:
(* Alternative 1: use fontsize to change the marker size *)
lp1 := ListPlot[{#} & /# #1,
PlotMarkers -> {Style["\[FilledSquare]", FontSize -> Scaled[#2]]},
AspectRatio -> 1, AxesOrigin -> {0, 0},
PlotRange -> {{-5, 1}, {-5, 1}},
PlotStyle -> Hue /# RandomReal[1, {Length##1}],
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick,
Line##1}, Frame -> True, FrameTicks -> All] &;
(* usage example *)
lp1 ## {data, .30}
(* Alternative 2: use the second parameter of PlotMarkers to control scaled size *)
lp2 := ListPlot[{#} & /# #1,
PlotMarkers -> {Graphics#{Rectangle[]}, #2}, AspectRatio -> 1,
AxesOrigin -> {0, 0}, PlotRange -> {{-5, 1}, {-5, 1}},
PlotStyle -> Hue /# RandomReal[1, {Length##1}],
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick,
Line##1}, Frame -> True, FrameTicks -> All] &
(* usage example *)
lp2 ## {data, 1/5.75}
In both cases, you need to use Epilog, otherwise the lines joining points are occluded by the markers. Both alternatives produce the following output:
Alternatively, you can use Graphics, RegionPlot, ContourPlot, BubbleChart with appropriate transformations of data to get results similar to the one in ListPlot output above.
Using Graphics primitives:
(* data transformation to define the regions *)
trdataG[data_, size_] := data /. {a_, b_} :>
{{a - size/2, b - size/2}, {a + size/2, b + size/2}};
(* plotting function *)
gr := Graphics[
{
{Hue[RandomReal[]], Rectangle[##]} & ### trdataG ## {#1, #2},
GrayLevel[.3], PointSize[.02], Thick, Point##1, Line##1},
PlotRange -> {{-5, 1}, {-5, 1}
},
PlotRangePadding -> 0, Axes -> True, AxesOrigin -> {0, 0},
Frame -> True, FrameTicks -> All] &
(* usage example *)
gr ## {data, .99}
Using BubbleChart:
(* Transformation of data to a form that BubbleChart expects *)
dataBC[data_] := data /. {a_, b_} :> {a, b, 1};
(* custom markers *)
myMarker[size_][{{xmin_, xmax_}, {ymin_, ymax_}}, ___] :=
{EdgeForm[], Rectangle[{(1/2) (xmin + xmax) - size/2, (1/2) (ymin + ymax) -
size/2}, {(1/2) (xmin + xmax) + size/2, (1/2) (ymin + ymax) + size/2}]};
(* charting function *)
bc := BubbleChart[dataBC[#1], ChartElementFunction -> myMarker[#2],
ChartStyle -> Hue /# RandomReal[1, {Length##1}], Axes -> True,
AxesOrigin -> {0, 0}, PlotRange -> {{-5, 1}, {-5, 1}},
PlotRangePadding -> 0, AspectRatio -> 1, FrameTicks -> All,
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick, Line##1}] &
(* usage example *)
bc ## {data, .99}
Using RegionPlot:
(* Transformation of data to a form that RegionPlot expects *)
trdataRP[data_, size_] := data /. {a_, b_} :>
a - size/2 <= x <= a + size/2 && b - size/2 <= y <= b + size/2
(* charting function *)
rp := RegionPlot[Evaluate#trdataRP[#1, #2], {x, -5, 1}, {y, -5, 1},
AspectRatio -> 1, Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{-5, 1}, {-5, 1}},
PlotStyle -> Hue /# RandomReal[1, {Length##1}], FrameTicks -> All,
PlotPoints -> 100, BoundaryStyle -> None,
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick, Line##1}] &
(* usage example *)
rp ## {data, .99}
Using ContourPlot:
(* Transformation of data to a form that ContourPlot expects *)
trdataRP[data_, size_] := data /. {a_, b_} :>
a - size/2 <= x <= a + size/2 && b - size/2 <= y <= b + size/2;
trdataCP[data_, size_] := Which ## Flatten#
Thread[{trdataRP[data, size], Range#Length#data}];
(* charting function *)
cp := ContourPlot[trdataCP[#1, #2], {x, -5, 1}, {y, -5, 1},
AspectRatio -> 1, Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{-5, 1}, {-5, 1}}, FrameTicks -> All,
ExclusionsStyle -> None, PlotPoints -> 100,
ColorFunction -> Hue,
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick, Line##1}] &
(* usage example *)
cp ## {data, .99}
may be
sol = Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers];
pts = Cases[sol, {_ -> n_, _ -> m_} :> {n, m}];
ListPlot[pts, Mesh -> All, Joined -> True, AxesOrigin -> {0, 0},
PlotMarkers -> {Automatic, 10}]
Can also extract the points to plot using
{#[[1, 2]], #[[2, 2]]} & /# sol
I'm trying to combine 3 functions graphed on a Plot[] and 1 function graphed on a ParametricPlot[]. My equations are as follows:
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1}, PlotLegend -> {"-2 x", "-2 \!\(\*SqrtBox[\(x\)]\)", "-2 \!\(\*SuperscriptBox[\(x\), \(3/5\)]\)"}]
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u,0, 1.40138}, PlotLegend -> {"Problem 3"}]
Show[plota, plotb]
This is the image it gives:
As yoda said, PlotLegends is terrible. However, if you don't mind setting the plot styles manually and repeating them lateron, ShowLegend can help.
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1},
PlotStyle -> {{Red}, {Blue}, {Orange}}];
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u, 0, 1.40138},
PlotStyle -> {{Black}}];
And now
ShowLegend[Show[plota, plotb],
{{{Graphics[{Red, Line[{{0, 0}, {1, 0}}]}], Label1},
{Graphics[{Blue, Line[{{0, 0}, {1, 0}}]}], Label2},
{Graphics[{Orange, Line[{{0, 0}, {1, 0}}]}], Label3},
{Graphics[{Black, Line[{{0, 0}, {1, 0}}]}], Label4}},
LegendSize -> {0.5, 0.5}, LegendPosition -> {0.5, -0.2}}]
which will give you this:
You can also write some simple functions to make this a little less cumbersome, if you deal with this problem often.
Well, the root cause of the error is the PlotLegends package, which is a terrible, buggy package. Removing that, Show combines them correctly:
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1}]
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u,
0, 1.40138}]
Show[plota, plotb]
You can see Simon's solution here for ideas to label your different curves without using PlotLegends. This answer by James also demonstrates why PlotLegends has the reputation it has...
You can still salvage something with the PlotLegends package. Here's an example using ShowLegends that you can modify to your tastes
colors = {Red, Green, Blue, Pink};
legends = {-2 x, -2 Sqrt[x], -2 x^(3/5), "Problem 3"};
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1},
PlotStyle -> colors[[1 ;; 3]]];
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u,
0, 1.40138}, PlotStyle -> colors[[4]]];
ShowLegend[
Show[plota,
plotb], {Table[{Graphics[{colors[[i]], Thick,
Line[{{0, 0}, {1, 0}}]}], legends[[i]]}, {i, 4}],
LegendPosition -> {0.4, -0.15}, LegendSpacing -> 0,
LegendShadow -> None, LegendSize -> 0.6}]
As the other answers pointed out, the culprit is PlotLegend. So, sometimes is useful to be able to roll your own plot legends:
plotStyle = {Red, Green, Blue};
labls = {"a", "b", "Let's go"};
f[i_, s_] := {Graphics[{plotStyle[[i]], Line[{{0, 0}, {1, 0}}]},
ImageSize -> {15, 10}], Style[labls[[i]], s]};
Plot[{Sin[x], Sin[2 x], Sin[3 x]}, {x, 0, 2 Pi},
PlotStyle -> plotStyle,
Epilog ->
Inset[Framed[Style#Column[{Grid[Table[f[i, 15], {i, 1, 3}]]}]],
Offset[{-2, -2}, Scaled[{1, 1}]], {Right, Top}],
PlotRangePadding -> 1
]
Given a set of points in the plane T={a1,a2,...,an} then Graphics[Polygon[T]] will plot the polygon generated by the points. How can I add labels to the polygon's vertices? Have merely the index as a label would be better then nothing. Any ideas?
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{{LightGray, Polygon[pts]},
{pts /. {x_, y_} :> Text[Style[{x, y}, Red], {x, y}]}}
]
To add point also
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{{LightGray, Polygon[pts]},
{pts /. {x_, y_} :> Text[Style[{x, y}, Red], {x, y}, {0, -1}]},
{pts /. {x_, y_} :> {Blue, PointSize[0.02], Point[{x, y}]}}
}
]
update:
Use the index:
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{{LightGray, Polygon[pts]},
{pts /. {x_, y_} :>
Text[Style[Position[pts, {x, y}], Red], {x, y}, {0, -1}]}
}
]
Nasser's version (update) uses pattern matching. This one uses functional programming. MapIndexed gives you both the coordinates and their index without the need for Position to find it.
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{
{LightGray, Polygon[pts]},
MapIndexed[Text[Style[#2[[1]], Red], #1, {0, -1}] &, pts]
}
]
or, if you don't like MapIndexed, here's a version with Apply (at level 1, infix notation ###).
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
idx = Range[Length[pts]];
Graphics[
{
{LightGray, Polygon[pts]},
Text[Style[#2, Red], #1, {0, -1}] & ### ({pts, idx}\[Transpose])
}
]
This can be expanded to arbitrary labels as follows:
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
idx = {"One", "Two", "Three"};
Graphics[
{
{LightGray, Polygon[pts]},
Text[Style[#2, Red], #1, {0, -1}] & ### ({pts, idx}\[Transpose])
}
]
You can leverage the options of GraphPlot for this. Example:
c = RandomReal[1, {3, 2}]
g = GraphPlot[c, VertexLabeling -> True, VertexCoordinateRules -> c];
Graphics[{Polygon#c, g[[1]]}]
This way you can also make use of VertexLabeling -> Tooltip, or VertexRenderingFunction if you want to. If you do not want the edges overlaid, you may add EdgeRenderingFunction -> None to the GraphPlot function. Example:
c = RandomReal[1, {3, 2}]
g = GraphPlot[c, VertexLabeling -> All, VertexCoordinateRules -> c,
EdgeRenderingFunction -> None,
VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02],
Black, Text[#2, #1]} &)];
Graphics[{Brown, Polygon#c, g[[1]]}]