Related
I am brand new to Mathematica and am having trouble putting two-dimensional error bars on a graph. I have a table with the data format: (r, sr, x, sx, y, sy) where r, x, and y are means and sr, sx, and sy are the standard deviations. I want to plot the x versus y columns and did this successfully with ListPlot:
Show[
ListPlot[meanlist[[All, {3, 5}]]], Graphics[Circle[{0, 0}, 20]],
PlotRange -> All, AspectRatio -> 1,
AxesLabel -> {Style["y [mm]", Bold, Medium],
Style["z [mm]", Bold, Medium]},
AxesOrigin -> {0, 0}]
If really necessary, I could leave it at that. However, I also want to add the x and y error bars. I tried doing this using ErrorListPlot:
ErrorListPlot[{{meanlist[[All, {3, 5}]]},
ErrorBar[meanlist[[All, {4, 6}]]]},
PlotRange -> All, AspectRatio -> 1,
AxesLabel -> {Style["y [mm]", Bold, Medium],
Style["z [mm]", Bold, Medium]},
AxesOrigin -> {0, 0},
ErrorBarFunction -> Automatic]
What I get out is the following (I truncated the two lists after the first line because they are long):
ErrorListPlot[{{{{-5.34473, -9.16194}, {-7.87379, -6.57843},...,
ErrorBar[{{0.501015, 0.72511}, {0.48202, 0.703881},...,
AxesLabel -> {Style["y [mm]", Bold, Medium],
Style["z [mm]", Bold, Medium]},
AxesOrigin -> {0, 0},
ErrorBarFunction -> Automatic]
In other words, it spits out lists of properly paired coordinates and error amounts followed by all the parameters I set for the graph, but it does not actually create a plot. I have included Needs["ErrorBarPlots`"]; and I'm no sure what else could be wrong. Any ideas?
try this:
ErrorListPlot[
{#[[{3, 5}]], ErrorBar[#[[4]], #[[6]]] } & /# meanlist ]
Aside, The final result you saw is typical of mathematica when you supply a function with invalid arguments, it repeats back what you entered rather than reporting an error.
I am trying to plot a list of functions with a legend using PlotLegend in Mathematica v8. As a simple test illustrating what I'm trying to do.
<<PlotLegends`
test = Table[f[x], {f, {Sin, Cos, Tan, Log, Exp}}]
Plot[test, {x, 0, 1}, PlotRange -> Full, Axes -> {True, False},
PlotStyle -> Thick, AxesOrigin -> {0, 0},
PlotLegend -> {"Sin", "Cos", "Tan", "Log", "Exp"},
LegendPosition -> {0, -0.5}, LegendShadow -> None]
Gives as output
{Sin[x], Cos[x], Tan[x], Log[x], E^x}
However, if I explicitly put the table in the Plot command, I get the correct legend.
Plot[{Sin[x], Cos[x], Tan[x], Log[x], Exp[x]}, {x, 0, 1},
PlotRange -> Full, Axes -> {True, False}, PlotStyle -> Thick,
AxesOrigin -> {0, 0},
PlotLegend -> {"Sin", "Cos", "Tan", "Log", "Exp"},
LegendPosition -> {0, -0.5}, LegendShadow -> None]
For my actual application, I'm putting together a list of functions within a Do loop, so the latter Plot command is not ideal.
Any suggestions would be greatly appreciated.
Cheers,
Mike
Replace Plot[test, ...] with Plot[Evaluate#test, ...].
The problem is that Plot takes the first argument unevaluated and only evaluates it when calculating points. Therefore when it determines the labels, it only sees a single argument test, not a list, and therefore it only outputs one label. Evaluate#test tells Mathematica to evaluate test before passing it to Plot even though Plot is defined to take the argument unevaluated. This way, Plot sees the list you stored in test and knows to generate several labels.
When exporting rather complicated plots (especially ListDensityPlot) as a PDF or EPS (for publication, for example), the resulting file size can be quite large. For example:
data = Flatten[Table[{f0, f, Exp[-(f - f0)^2/25^2]}, {f0, 500, 700, 5}, {f, 300,
900}], 1];
plot=ListDensityPlot[data,PlotRange->{Automatic,Automatic,{0,1}},InterpolationOrder->0]
This example data set is on the order of the size I typically work with. When I export using Export["C:\\test.pdf", plot], it generates a PDF file 23.9MB in size. If I instead try Export["C:\\test1.pdf", Rasterize[plot]] it is far smaller, but the integrity and rescalability of the image naturally suffers.
This is complicated further if my actual figure is a combined plot, such as (Edit: f goes to 900)
plot2 = Show[plot, Plot[x, {x, 500, 900}, PlotStyle -> Thick]]
(or with some usage of Epilog) where I'd love to have the background ListDensityPlot be rasterized, but keep the other markup and plots in ``vector'' form. Or at the very least, the frame labels be non-rasterized.
Is there any way to do this?
Or, to accomplish the same goal via some other clever method?
Update
I've checked out the related question, but that's gotta be way more complicated than it needs to be (essentially exporting then importing). I've been able to utilize some of the tricks in that question to extract the plot separately from the axes:
axes = Graphics[{}, Options[plot2]]
plots = Graphics[plot2[[1]]]
But, the plots term loses the AspectRatio and PlotRange, etc. plots can be hit with a Rasterize, but it needs dimensional fixing.
And then, how to combine them together?
This is exactly the kind of problem for which I wrote the function linked here:
http://pages.uoregon.edu/noeckel/computernotes/Mathematica/listContourDensityPlot.html
It's based on the same idea as in Heike's answer -- I just added some more features so that you can safely change the aspect ratio, opacity, and combine with other plots. See my comment in Heike's answer.
To try it with your data, do something like this:
plot = Show[
listContourDensityPlot[data,
PlotRange -> {Automatic, Automatic, {0, 1}},
InterpolationOrder -> 0, Contours -> None],
Graphics[Line[{{500, 500}, {700, 700}}]]]
There are a couple of similar functions linked from the parent page, too.
If you're dealing with 2D plots, you could combine a rasterized plot with vectorized axes by using Inset. For example
plot2 = ListDensityPlot[data,
PlotRange -> {Automatic, Automatic, {0, 1}},
InterpolationOrder -> 0, Axes -> False, Frame -> False,
PlotRangePadding -> 0];
plotRange = PlotRange /. AbsoluteOptions[plot2, PlotRange];
plot = Graphics[{
Inset[Image[plot2], plotRange[[All, 1]], {Left, Bottom}, Scaled[{.96, .96}]],
Line[{{500, 500}, {700, 700}}]},
Frame -> True, AspectRatio -> 1,
PlotRange -> plotRange, PlotRangePadding -> Scaled[.02]]
Export["test.pdf", plot]
produces a .pdf of about 400 KB. The frame, tick marks, and black line are still vectorized, so they stay sharp when zooming in:
If you are exporting as PDF, EPs or WMF, then the text should remain as vectors even if you have a rasterized component to the graphics.
I think the trick is to set the number of plot points to some low number in the ListDensityPlot command and then export as PDF as normal.
How about just plotting the function rather than making a list?
plot=DensityPlot[Exp[-(f - f0)^2/25^2], {f0, 500, 700}, {f, 300, 900},
Epilog -> {Thick, Line[{{500, 500}, {700, 700}}]}, PlotPoints -> 50]
Export["test.pdf", plot]
file size 1.1MB
I have a graph as a result of executing ListPlot[] function.
I can manually edit this graph by moving points to a different location
and also adding new points using the Drawing Tools.
How do I get the coordinates of new and changed points from the edited graphics?
I'm not sure if the following is anything like what you want,but nevertheless:
If I use ListPlot as follows:
lp1 = Labeled[
ListPlot[Diagonal#Table[{x, y}, {x, 0, 5}, {y, 5}],
PlotStyle -> {Directive[Red, PointSize[Large]]}], "lp1"];
By double clicking on one of the red points twice to get the selection to the level of the points, I can then move the individual points, e.g., to make the points lie on a curve (rather than a straight line). I now want to extract these points (and say use them in a new ListPlot) [see plots below]
If I click on the bracket of the plot graphic and use "Show Expression" (Command Shift E on a Mac), I can 'see' the coordinates of the modified points which may then be extracted. For example:
expr = Cell[
BoxData[GraphicsBox[{RGBColor[1, 0, 0], PointSize[Large],
PointBox[{{0., 1.}, {0.8254488458250212,
2.886651181634783}, {1.9301795383300084`,
3.925201233010209}, {3.046546974446661,
4.597525796319094}, {4., 5.}}]},
AspectRatio -> NCache[GoldenRatio^(-1), 0.6180339887498948],
Axes -> True, PlotRange -> Automatic,
PlotRangeClipping -> True]], "Input",
CellChangeTimes -> {{3.504427833788156*^9, 3.50442786823486*^9}}];
Modifying a very useful approach originally suggested by Yaroslav Bulatov, which may be found here
modpoints = Flatten[Cases[expr, PointBox[___], Infinity][[All, 1]], {{2, 1}}]
EDIT
As pointed out by belisarius, it is desirable to be able to extract 'manually' added points (which may be added to the generated plot using 'point' from the Drawing Tools palette). A better way of extracting (after 'Show Expression' ...) is probably the following:
modpoints = Cases[Cases[expr, PointBox[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
Of course, 'Show Expression' is not the only approach.
InputForm is another possibility. For example,
expr2 = InputForm[ListPlotGraphic]
modpoints = Cases[Cases[expr, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
where "ListPlotGraphic" is the modified graphic (inserted by 'copy and paste'), will also work.
Example plots
Addendum
The above can be automated with a little notebook programming:
lp1 = Labeled[
ListPlot[Diagonal#Table[{x, y}, {x, 0, 5}, {y, 5}],
PlotStyle -> {Directive[Red, PointSize[Large]]}],
Button["Print points",
With[{nb = ButtonNotebook[]},
SelectionMove[nb, All, CellContents];
Print[Cases[NotebookRead[nb],
PointBox[{{_?NumericQ, _?NumericQ} ..}] |
PointBox[{_?NumericQ, _?NumericQ}], Infinity]]]]]
Running the above, moving the last two original (red) points and adding a couple of extra points in blue with the drawing tools then pressing the button yields
You can see that there is a single PointBox for the original data and a new PointBox for each of the added points. Of course, by modifying the above code, you can do more than simply print out the raw point coordinates.
This approach makes every data point a locator that can be moved. New locators can be added and old ones deleted as appropriate. The best fit and variance are updated after every change.
Here's some data of some exponential growth with some errors and a data point missing
data = Delete[Table[{t, (1 + RandomReal[{-.2, .2}])Exp[t]}, {t, 0, 2, .2}], 6];
A little formatting command:
nForm = NumberForm[#, {2, 2}, NumberPadding -> {"", "0"}] &;
Finally, here's the code to make the manipulable graphics. New locators/data points are added using Alt-Click (or Ctrl-Alt-Click on linux). If you click on the list of points on the left, then a new window is opened containing the points in input form.
Manipulate[
LocatorPane[Dynamic[pts, {None, Temporary, Automatic}],
nlm = Block[{a,b,t}, NonlinearModelFit[Sort[pts], a Exp[t] + b, {a, b}, t]];
Show[Plot[{Exp[t], nlm[t]}, {t, 0, 2},
PlotStyle -> {{Thick, LightGray}, Dotted}, PlotRangePadding -> Scaled[0.1]],
ListPlot[data, PlotStyle -> Blue], AxesLabel -> Block[{t,f}, {t, f[t]}]],
LocatorAutoCreate -> True, Appearance -> Style["\[CircleDot]", Red]],
{nlm, None}, {{pts, data}, None},
Dynamic[Pane[EventHandler[
nForm#Grid[Prepend[pts, {"x", "y"}], Dividers -> {False, 2 -> True}],
{"MouseClicked" :> (CreateDocument[{ExpressionCell[nlm["Data"], "Output"]},
WindowTitle -> "Data"])}], ImageSize -> {100, 250},
ImageSizeAction -> "Scrollable", Scrollbars -> {False, True}]],
Pane[Dynamic[nForm#Row#{nlm,Row[{"\tvariance = ",nlm["EstimatedVariance"]}]}]],
ControlPlacement -> {Left, Left, Left, Top}]
In the above I've used the locators to correct a couple of outliers and restored the missing data point.
The easy option is to use the "Get Coordinates" menu option. If you right click on the graphic, in the pop-up menu you'll see "Get Coordinates" which allows you to mouse-over a point and see that point's coordinates. Of course this isn't going to be accurate... but the way you're editing the graphic isn't very accurate either.
You could use the InputForm (or FullForm) function, but I am not sure how well this works...
In[1]:= a = ListPlot[{{1, 0}, {0, 1}, {1, 1}}];
a // InputForm
Out[2]//InputForm=
Graphics[{{{}, {Hue[0.67, 0.6, 0.6], Point[{{1., 0.}, {0., 1.}, {1., 1.}}]},
{}}}, {AspectRatio -> GoldenRatio^(-1), Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{0., 1.}, {0., 1.}}, PlotRangeClipping -> True,
PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]
You'll notice that there's a Point expression in there.
The third option would be to use Locator in some way I guess.
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.