Related
Frequently I have to visualize multiple datasets simultaneously, usually in ListPlot or its Log-companions. Since the number of datasets is usually larger than the number of easily distinguishable line styles and creating large plot legends is still somewhat unintuitiv I am still searching for a good way to annotate the different lines/sets in my plots. Tooltip is nice when working on screen, but they don't help if I need to pritn the plot.
Recently, I played around with the Mesh option to enumerate my datasets and found some weird stuff
GraphicsGrid[Partition[Table[ListPlot[
Transpose#
Table[{Sin[x], Cos[x], Tan[x], Cot[x]}, {x, 0.01, 10, 0.1}],
PlotMarkers -> {"1", "2", "3", "4"}, Mesh -> i, Joined -> True,
PlotLabel -> "Mesh\[Rule]" <> ToString[i], ImageSize -> 180], {i,
1, 30}], 4]]
The result looks like this on my machine (Windows 7 x64, Mathematica 8.0.1):
Funnily, for Mesh->2, 8 , and 10 the result looks like I expected it, the rest does not. Either I don't understand the Mesh option, or it doesn't understand me.
Here are my questions:
is Mesh in ListPLot bugged or do I use it wrongly?
how could I x-shift the mesh points of successive sets to avoid overprinting?
do you have any other suggestions how to annotate/enumerate multiple datasets in a plot?
You could try something along these lines. Make each line into a button which, when clicked, identifies itself.
plot=Plot[{Sin[x],Cos[x]},{x,0,2*Pi}];
sinline=plot[[1,1,3,2]];
cosline=plot[[1,1,4,2]];
message="";
altplot=Append[plot,PlotLabel->Dynamic[message]];
altplot[[1,1,3,2]]=Button[sinline,message="Clicked on the Sin line"];
altplot[[1,1,4,2]]=Button[cosline,message="Clicked on the Cos line"];
altplot
If you add an EventHandler you can get the location where you clicked and add an Inset with the relevant positioned label to the plot. Wrap the plot in a Dynamic so it updates itself after each button click. It works fine.
In response to comments, here is a fuller version:
plot = Plot[{Sin[x], Cos[x]}, {x, 0, 2*Pi}];
sinline = plot[[1, 1, 3, 2]];
cosline = plot[[1, 1, 4, 2]];
AddLabel[label_] := (AppendTo[plot[[1]],
Inset[Framed[label, Background -> White], pt]];
(* Remove buttons for final plot *)
plainplot = plot;
plainplot[[1, 1, 3, 2]] = plainplot[[1, 1, 3, 2, 1]];
plainplot[[1, 1, 4, 2]] = plainplot[[1, 1, 4, 2, 1]]);
plot[[1, 1, 3, 2]] = Button[sinline, AddLabel["Sin"]];
plot[[1, 1, 4, 2]] = Button[cosline, AddLabel["Cos"]];
Dynamic[EventHandler[plot,
"MouseDown" :> (pt = MousePosition["Graphics"])]]
To add a label click on the line. The final annotated chart, set to 'plainplot', is printable and copyable, and contains no dynamic elements.
[Later in the day] Another version, this time generic, and based on the initial chart. (With parts of Mark McClure's solution used.) For different plots 'ff' and 'spec' can be edited as desired.
ff = {Sin, Cos, Tan, Cot};
spec = Range[0.1, 10, 0.1];
(* Plot functions separately to obtain line counts *)
plots = Array[ListLinePlot[ff[[#]] /# spec] &, Length#ff];
plots = DeleteCases[plots, Line[_?(Length[#] < 3 &)], Infinity];
numlines = Array[Length#Cases[plots[[#]], Line[_], Infinity] &,
Length#ff];
(* Plot functions together for annotation plot *)
plot = ListLinePlot[##spec & /# ff];
plot = DeleteCases[plot, Line[_?(Length[#] < 3 &)], Infinity];
lbl = Flatten#Array[ConstantArray[ToString#ff[[#]],
numlines[[#]]] &, Length#ff];
(* Line positions to substitute with buttons *)
linepos = Position[plot, Line, Infinity];
Clear[line];
(* Copy all the lines to line[n] *)
Array[(line[#] = plot[[Sequence ## Most#linepos[[#]]]]) &,
Total#numlines];
(* Button function *)
AddLabel[label_] := (AppendTo[plot[[1]],
Inset[Framed[label, Background -> White], pt]];
(* Remove buttons for final plain plot *)
plainplot = plot;
bpos = Position[plainplot, Button, Infinity];
Array[(plainplot[[Sequence ## Most#bpos[[#]]]] =
plainplot[[Sequence ## Append[Most#bpos[[#]], 1]]]) &,
Length#bpos]);
(* Substitute all the lines with line buttons *)
Array[(plot[[Sequence ## Most#linepos[[#]]]] = Button[line[#],
AddLabel[lbl[[#]]]]) &, Total#numlines];
Dynamic[EventHandler[plot,
"MouseDown" :> (pt = MousePosition["Graphics"])]]
Here's how it looks. After annotation the plain graphics object can be found set to the 'plainplot' variable.
One approach is to generate the plots separately and then show them together. This yields code that is more like yours than the other post, since PlotMarkers seems to play the way we expect when dealing with one data set. We can get the same coloring using ColorData with PlotStyle. Here's the result:
ff = {Sin, Cos, Tan, Cot};
plots = Table[ListLinePlot[ff[[i]] /# Range[0.1, 10, 0.1],
PlotStyle -> {ColorData[1, i]},
PlotMarkers -> i, Mesh -> 22], {i, 1, Length[ff]}];
(* Delete the spurious asymptote looking thingies. *)
plots = DeleteCases[plots, Line[ll_?(Length[#] < 4 &)], Infinity];
Show[plots, PlotRange -> {-4, 4}]
Are you going to be plotting computable curves or actual data?
If it's computable curves, then it's common to use a plot legend (key).
You can use different dashings and thicknesses to differentiate between the lines on a grayscale printer. There are many examples in the PlotLegends documentation.
If it's real data, then normally the data is sparse enough that you can use PlotMarkers for the actual data points (i.e. don't specify Mesh). You can use automatic PlotMarkers, or you can use custom PlotMarkers including BoxWhisker markers to indicate the various uncertainties.
When plotting a function using Plot, I would like to obtain the set of data points plotted by the Plot command.
For instance, how can I obtain the list of points {t,f} Plot uses in the following simple example?
f = Sin[t]
Plot[f, {t, 0, 10}]
I tried using a method of appending values to a list, shown on page 4 of Numerical1.ps (Numerical Computation in Mathematica) by Jerry B. Keiper, http://library.wolfram.com/infocenter/Conferences/4687/ as follows:
f = Sin[t]
flist={}
Plot[f, {t, 0, 10}, AppendTo[flist,{t,f[t]}]]
but generate error messages no matter what I try.
Any suggestions would be greatly appreciated.
f = Sin[t];
plot = Plot[f, {t, 0, 10}]
One way to extract points is as follows:
points = Cases[
Cases[InputForm[plot], Line[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity];
ListPlot to 'take a look'
ListPlot[points]
giving the following:
EDIT
Brett Champion has pointed out that InputForm is superfluous.
ListPlot#Cases[
Cases[plot, Line[___], Infinity], {_?NumericQ, _?NumericQ},
Infinity]
will work.
It is also possible to paste in the plot graphic, and this is sometimes useful. If,say, I create a ListPlot of external data and then mislay the data file (so that I only have access to the generated graphic), I may regenerate the data by selecting the graphic cell bracket,copy and paste:
ListPlot#Transpose[{Range[10], 4 Range[10]}]
points = Cases[
Cases[** Paste_Grphic _Here **, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
Edit 2.
I should also have cross-referenced and acknowledged this very nice answer by Yaroslav Bulatov.
Edit 3
Brett Champion has not only pointed out that FullForm is superfluous, but that in cases where a GraphicsComplex is generated, applying Normal will convert the complex into primitives. This can be very useful.
For example:
lp = ListPlot[Transpose[{Range[10], Range[10]}],
Filling -> Bottom]; Cases[
Cases[Normal#lp, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
gives (correctly)
{{1., 1.}, {2., 2.}, {3., 3.}, {4., 4.}, {5., 5.}, {6., 6.}, {7.,
7.}, {8., 8.}, {9., 9.}, {10., 10.}}
Thanks to Brett Champion.
Finally, a neater way of using the general approach given in this answer, which I found here
The OP problem, in terms of a ListPlot, may be obtained as follows:
ListPlot#Cases[g, x_Line :> First#x, Infinity]
Edit 4
Even simpler
ListPlot#Cases[plot, Line[{x__}] -> x, Infinity]
or
ListPlot#Cases[** Paste_Grphic _Here **, Line[{x__}] -> x, Infinity]
or
ListPlot#plot[[1, 1, 3, 2, 1]]
This evaluates to True
plot[[1, 1, 3, 2, 1]] == Cases[plot, Line[{x__}] -> x, Infinity]
One way is to use EvaluationMonitor option with Reap and Sow, for example
In[4]:=
(points = Reap[Plot[Sin[x],{x,0,4Pi},EvaluationMonitor:>Sow[{x,Sin[x]}]]][[2,1]])//Short
Out[4]//Short= {{2.56457*10^-7,2.56457*10^-7},<<699>>,{12.5621,-<<21>>}}
In addition to the methods mentioned in Leonid's answer and my follow-up comment, to track plotting progress of slow functions in real time to see what's happening you could do the following (using the example of this recent question):
(* CPU intensive function *)
LogNormalStableCDF[{alpha_, beta_, gamma_, sigma_, delta_}, x_] :=
Block[{u},
NExpectation[
CDF[StableDistribution[alpha, beta, gamma, sigma], (x - delta)/u],
u \[Distributed] LogNormalDistribution[Log[gamma], sigma]]]
(* real time tracking of plot process *)
res = {};
ListLinePlot[res // Sort, Mesh -> All] // Dynamic
Plot[(AppendTo[res, {x, #}]; #) &#
LogNormalStableCDF[{1.5, 1, 1, 0.5, 1}, x], {x, -4, 6},
PlotRange -> All, PlotPoints -> 10, MaxRecursion -> 4]
etc.
Here is a very efficient way to get all the data points:
{plot, {points}} = Reap # Plot[Last#Sow#{x, Sin[x]}, {x, 0, 4 Pi}]
Based on the answer of Sjoerd C. de Vries, I've now written the following code which automates a plot preview (tested on Mathematica 8):
pairs[x_, y_List]:={x, #}& /# y
pairs[x_, y_]:={x, y}
condtranspose[x:{{_List ..}..}]:=Transpose # x
condtranspose[x_]:=x
Protect[SaveData]
MonitorPlot[f_, range_, options: OptionsPattern[]]:=
Module[{data={}, plot},
Module[{tmp=#},
If[FilterRules[{options},SaveData]!={},
ReleaseHold[Hold[SaveData=condtranspose[data]]/.FilterRules[{options},SaveData]];tmp]]&#
Monitor[Plot[(data=Union[data, {pairs[range[[1]], #]}]; #)& # f, range,
Evaluate[FilterRules[{options}, Options[Plot]]]],
plot=ListLinePlot[condtranspose[data], Mesh->All,
FilterRules[{options}, Options[ListLinePlot]]];
Show[plot, Module[{yrange=Options[plot, PlotRange][[1,2,2]]},
Graphics[Line[{{range[[1]], yrange[[1]]}, {range[[1]], yrange[[2]]}}]]]]]]
SetAttributes[MonitorPlot, HoldAll]
In addition to showing the progress of the plot, it also marks the x position where it currently calculates.
The main problem is that for multiple plots, Mathematica applies the same plot style for all curves in the final plot (interestingly, it doesn't on the temporary plots).
To get the data produced into the variable dest, use the option SaveData:>dest
Just another way, possibly implementation dependent:
ListPlot#Flatten[
Plot[Tan#t, {t, 0, 10}] /. Graphics[{{___, {_, y__}}}, ___] -> {y} /. Line -> List
, 2]
Just look into structure of plot (for different type of plots there would be a little bit different structure) and use something like that:
plt = Plot[Sin[x], {x, 0, 1}];
lstpoint = plt[[1, 1, 3, 2, 1]];
I am trying to plot multiple lists in the same plot in Mathematica (ListLinePlot) and use PlotMarkers and the PlotLegend Package to get the final figure. The issue is that Mathematica puts a marker for every point and this makes it hard to tell which marker is where in the plot. Is it possible to have a plot marker appear every n sample (e.g. every 10 points for a 100 point plot).
The Directive at the moment is PlotMarkers->{Automatic, Small}.
I think adding something like Mesh->10 should work for you:
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
ListLinePlot[data, PlotMarkers -> {Automatic, Small}, Mesh -> 10]
If you want more control over the location of the plot markers than Brett's answer gives you, then you probably have to place the markers manually. Eg (modifying Brett's example)
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
col = {Red, Blue, Green};
decimate[i_] := {col[[i]], PointSize -> Medium,
Point /# Transpose[{Range[1, 100, 10], data[[i, 1 ;; -1 ;; 10]]}]}
ListLinePlot[data, PlotStyle -> col, Epilog -> Table[decimate[i], {i, 3}]]
Of course Point can be replaced with any graphics object you want - eg Text, Inset etc...
Also remember you can use Tooltip to cause the marker coordinates to pop up when you pass the mouse pointer over it:
The example of what I was describing in the comment. The markers don't behave properly.
Apparently I cannot post images yet, but running the following code
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
ListLinePlot[data, PlotMarkers -> {Automatic, Small}, Mesh -> 5]
should give improper results. Also the number of data and plots in the same figure is quite large to individually select which points and I would like to keep the same Directives for different plots and data ranges as they tend to vary between 100 to around 300 in each case and I have to save them in different tables as they are used in other calculations along the way.
Plot Posted by belisarius, running the code above
Given Graphics object, how do I determine the range of coordinates needed to include all of graphics? Basically I need something like what Show does by default, but I want to specify PlotRange,PlotRangePadding and ImagePadding explicitly.
Example, two Shows below should render the same
g = Graphics[{Thickness[1], CapForm["Round"], Line[{{0, 0}, {1, 1}}]}];
Show[g]
Show[g, PlotRange -> getPlotRange[g], PlotRangePadding->getPlotRangePadding[g], ImagePadding->getImagePadding[g]]
Motivation: fixing diagrams in this question
Update:
AbsoluteOptions gives me PlotRange but not the other two options. Explicitly specifying ImagePadding->Automatic changes appearance though it's supposedly Automatic by default.
Two images below show differently and I don't understand why
g = Graphics[{Thickness[1], CapForm["Round"], Line[{{0, 0}, {1, 1}}]}];
Show[g]
Show[g, Sequence ## AbsoluteOptions[Show[g]]]
Update 2:
A similar problem was brought up a year ago, with no solutions proposed, and not fixed as of Mathematica 8.0. To summarize
There's no way to reproduce Show[g] above with explicit setting of PlotRange
There's no way to get absolute ImagePadding used by Show[g]
Show[g,PlotRange->Automatic] looks different from Show[g]
AbsoluteOptions can give the wrong result for PlotRange
I can suggest the following Ticks hack:
pl = Plot[Sin[x], {x, 0, 10}];
Reap[Rasterize[Show[pl, Ticks -> {Sow[{##}] &, Sow[{##}] &}, ImageSize -> 0],
ImageResolution -> 1]][[2, 1]]
=> {{-0.208333, 10.2083}, {-1.04167, 1.04167}}
The trick is that real PlotRange is determined by the FrontEnd, not by the Kernel. So we must force the FrontEnd to render the graphics in order to get tick functions evaluated. This hack gives the complete PlotRange with explicit value of PlotRangePadding added.
More general solution taking into account a possibility that pl has non-standard value of DisplayFinction option and that it may have Axes option set to False:
completePlotRange[plot:(_Graphics|_Graphics3D|_Graph)] :=
Quiet#Last#
Last#Reap[
Rasterize[
Show[plot, Axes -> True, Frame -> False, Ticks -> (Sow[{##}] &),
DisplayFunction -> Identity, ImageSize -> 0], ImageResolution -> 1]]
One can get the exact PlotRange (without the PlotRangePadding added) with the following function:
plotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Quiet#Last#
Last#Reap[
Rasterize[
Show[plot, PlotRangePadding -> None, Axes -> True, Frame -> False,
Ticks -> (Sow[{##}] &), DisplayFunction -> Identity, ImageSize -> 0],
ImageResolution -> 1]]
P.S. On the Documentation page for PlotRange under the "More information" one can read: "AbsoluteOptions gives the actual settings for options used internally by Mathematica when the setting given is Automatic or All. " (emphasis mine). So it seems that the Documentation does not even guarantee that AbsoluteOptions will give correct values for PlotRange when it is not Automatic or All.
I, too, sometimes find it confusing how to get Mathematica to display Graphics in a consistent way, particularly when insetting graphics.
For the specified graphic g, it doesn't matter what you provide for the PlotRange, because Thickness[1] always draws a line whose thickness is equal to the horizontal plot range. In your example, Show[g, ___] gives the correct result:
.
Show[g], or simply g, is anomalous.
Why?
I don't know where/if this is documented, but here are a few things that might be relevant to the question.
Obviously DisplayForm[Graphics[___]] is a raster.
We can get a raster for g using Rasterize[g]. What is the RasterSize? From trial and
error, I found that RasterSize is 10 * screen resolution (reported as 72 pixels per inch on my system). How do I know this? If I rasterize g with resolutions less than 718, I get an image with dimensions {360,361}, whereas the default image size for g is 360 pixels on my system, so I figure to Show[] a graphic, Mathematica Rasterize's it at 10x the screen resolution. Anybody know if this is true? You can get your screen resolution (at least as Mathematica sees it) from the Options Inspector.
Edit
That the following expression evaluates as True seems to show that the displayed graphic is rasterized at the ImageSize:
ImportString[ExportString[Show[g,ImageSize->100],"PNG"]]
=== ImportString[ExportString[Rasterize[g,RasterSize->100,ImageSize->100],"PNG"]
To reproduce Show[g] when using PlotRange I need to use
Show[g,PlotRange->{{0,1},{0,1}},ImagePadding->90.3]
to get it to crop to the perimeter of the line. So it seems that Mathematica is telling the truth that the PlotRange is {{0,1},{0,1}} when using AbsoluteOptions[]. It is not reporting the actual value of ImagePadding. Perhaps because ImagePadding->Automatic is based on a rule that uses the current ImageSize, PlotRangeClipping,... settings? The ImagePadding of 90.3 only works for ImageSize->360; setting ImageSize->200 makes the ImagePadding value wrong. For your graphic, ImagePadding->90.3*OptionValue[ImageSize]/360 reproduces Show[g,ImageSize->_] on my system.
That's all I've found out so far.
You can try adding a recognizable object at a known location and then see where it shows up in the exported version to provide a scale reference. I thought a vector export (SVG or EPS) would be easier to parse, but I think raster is easier after playing around a bit.
For example, add a green rectangle covering the theoretical plot range:
g = Graphics[{Blue, Thickness[1], CapForm["Round"],
Line[{{0, 0}, {1, 1}}], Green, Rectangle[{0, 0}, {1, 1}]}];
im = Rasterize[g, ImageSize -> 360];
xy = Transpose[Position[ImageData[im], {0., 1., 0.}]];
pad = Map[{Min[#1], 360 - Max[#1] } &, xy];
Show[g, ImagePadding -> pad]
The code is basically identifying where all the green pixels are.
The padding in this case is {{92, 92}, {92, 92}}, but it need not be symmetrical.
How do you plot legends for functions without using the PlotLegends package?
I, too, was disappointed by the difficulty of getting PlotLegend to work correctly. I wrote my own brief function to make my own custom figure legends:
makePlotLegend[names_, markers_, origin_, markerSize_, fontSize_, font_] :=
Join ## Table[{
Text[
Style[names[[i]], FontSize -> fontSize, font],
Offset[
{1.5*markerSize, -(i - 0.5) * Max[markerSize,fontSize] * 1.25},
Scaled[origin]
],
{-1, 0}
],
Inset[
Show[markers[[i]], ImageSize -> markerSize],
Offset[
{0.5*markerSize, -(i - 0.5) * Max[markerSize,fontSize] * 1.25},
Scaled[origin]
],
{0, 0},
Background -> Directive[Opacity[0], White]
]
},
{i, 1, Length[names]}
];
It is flexible, but not so easy to use. "names" is a list of strings to render in the legend; "markers" is a list with the same length as "names" of Graphics objects representing the plot markers or graphics to render; "origin" is a two-element list with the absolute horizontal and vertical position of the upper-left corner of the legend; "markerSize" is the number of points to scale the markers to; "fontSize" is the font size; "font" is the name of the font to use. Here is an example:
Plot[{x, x^2}, {x, 0, 2}, PlotStyle -> {Blue, Red},
Epilog -> makePlotLegend[
{x, x^2},
(Graphics[{#, Line[{{-1, 0}, {1, 0}}]}]) & /# {Blue, Red},
{0.9, 0.3},
12,
12,
"Arial"
]
]
I would also be very interested in an answer to this question.
To tell you what is wrong with PlotLegends: It is terribly unstable and in many instances doesn't work at all.
Here is an example where PlotLegends screws up completely. Output is from Mathematica 7.0:
Assume that we have measured some data points corresponding to a number of functions, and we want to show how well they compare to the ideal function, or maybe how well they match with a calculated fit. No problem! We'll just Show[] the smooth plot together with a ListPlot of the data points, right?
It could look something like this:
Show[
Plot[{Sin[x], Sinh[x]}, {x, -Pi, Pi}],
ListPlot[Join[{#, Sin[#]} & /# Range[-Pi, Pi, .5],
{#, Sinh[#]} & /# Range[-Pi, Pi, .5]]]
]
Now we'd like to put a legend on the plot, so readers will know what on earth they're looking at. Easier said than done, mister! Let's add the PlotLegend to the Plot[]:
Show[
Plot[{Sin[x], Sinh[x]}, {x, -Pi, Pi}, PlotLegend -> {Sin[x], Sinh[x]}],
ListPlot[Join[{#, Sin[#]} & /# Range[-Pi, Pi, .5],
{#, Sinh[#]} & /# Range[-Pi, Pi, .5]]]
]
This looks GREAT! Publish immediately!
For such a basic and ubiquitously needed functionality, it sure has been a lot of work to find an alternative to PlotLegend that just works. The best alternative I've found so far has been to meticulously construct a list of plotstyles, then construct the legend by hand, and finally to show it together with the plot using ShowLegend[]. (See for example here) It's possible, but a lot of work.
So if anyone knows of a workaround to make PlotLegend work, an alternative package that works better, or just a neat way to get legends that can be automated easily, I would be very grateful! It would certainly make life a little bit easier.
If you are experiencing the weird behavior described by James When you are trying to use 'Show' to combine two images, then you should play around with using the 'Overlay' function instead of 'Show'.
Alternatively, I have found that as long as both graphics have a legend then 'Show' will render the composite image correctly.
If it looks a bit silly having two legends then you can remove the one from the second graphic by using options like:
PlotLegend -> {},
LegendPosition -> {0.1, 0.1},
LegendSize -> 0.001,
LegendShadow -> None,
LegendBorder -> None
This creates an empty and invisible legend but still allows the two graphics to be composed correctly by 'Show'.