I noticed that if I rotates a 3D image using the mouse, there is a little jitter or shaking in the notebook interface itself as I rotate the image around with the mouse.
i.e. the frame where the 3D image itself is, does shift a little up and down the notebook.
I tried all the tricks I know to prevent this, from setting different ImagePadding, PlotRangePadding, ImageMargins, PlotRange, ContentSize and everything else but no luck.
Here is a small example, I just used RegionPlot3D as an example, but any 3D plot will do.
Manipulate[
RegionPlot3D[True,
{x,1,2},{y,1,2},{z,1,2},
AxesLabel-> label,
ImageSize->{340,450},
ImagePadding->10,
ImageMargins->10,
MeshStyle->Automatic,
PlotRangePadding->1,
AxesOrigin->{0,0,0},
PlotRange->{{0,2},{0,2},{0,2}},
Boxed->False],
{n,0,ControlType->None},
SynchronousUpdating->False,
ContinuousAction->False
]
Now if you run the above, and using the mouse to rotate the little cube, you'll start noticing, once you release the mouse, that the notebook did jitter a little. Feel free to try any other settings.
It is annoying, as I do not like this shaking effect. Makes me dizzy.
Any expert here might know if it is option setting that I am overlooking in the Plot command itself, or may be something else? I'd like the plot frame and the notebook itself not to shake while I am rotating the image inside with the mouse. The problem again shows up when one release the mouse.
Mathematica 8.0.1 on windows 7.
thanks
--Nasser
ps. I tried to search if this was asked before, but did not spot something.
Try:
SphericalRegion -> True
Like in:
Manipulate[
RegionPlot3D[True, {x, 1, 2}, {y, 1, 2}, {z, 1, 2},
AxesLabel -> label, SphericalRegion -> True,
ImageSize -> {340, 450}, ImagePadding -> 10, ImageMargins -> 10,
MeshStyle -> Automatic, PlotRangePadding -> 1,
AxesOrigin -> {0, 0, 0}, PlotRange -> {{0, 2}, {0, 2}, {0, 2}},
Boxed -> False], {n, 0, ControlType -> None},
SynchronousUpdating -> False, ContinuousAction -> False]
From the Help:
With SphericalRegion->True, the image of a particular object remains consistent
in size, regardless of the orientation of the object.
Edit
Usage example in this answer: How to create 2D (3D) animation in Wolfram Mathematica with the camera following the object?
HTH!
Related
When changing the plot range of a histogram from Automatic to a plot range which exceeds the automatically calculated plot range, Mathematica draws an unwanted horizontal line which I cannot get rid of (see right histogram at value -4). Does anyone have a suggestion on that issue?
I'm running Mathematica V.8.0.1.0 on Mac OS 10.7.2.
In[1099]:=
data = {-1.2056, -1.46192, -1.30053, -2.52879, -0.99636, -1.73904, -1.164,
-1.83398,-0.97505, -0.503256, -0.63802, -0.785963, -0.711821, -0.820439, -1.8699,
-3.9659, -1.4456, -1.67021, -1.42009, -2.5644, -1.45002, -1.27806, -1.66529,
-1.67073, -3.31102, -3.38638};
HistogramLeft=Histogram[data, PlotRange -> Automatic]
HistogramRight=Histogram[data, PlotRange -> {-8, 0}]
It looks like you're using Frame -> {{True, False}, {True, False}} (or something similar.) If that's the case, you can turn off the normal axes entirely with Axes->False.
Look at the option AxesOrigin.
HistogramRight = Histogram[data, PlotRange -> {-8, 0}, BarOrigin -> Left, AxesOrigin -> {-8, 0}]
If I understand what you want, this is pretty easy, I think.
Try
HistogramRight =
Histogram[data, PlotRange -> {-8, 0}, BarOrigin -> Left,
PlotLabel -> Left, Axes -> {False, True}]
By the way, there is a new stack exchange for Mathematica at https://mathematica.stackexchange.com/
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
Please consider :
colors = {Red, Green, Blue};
style = {Thickness[.01], Thickness[.01], Thickness[.01]};
cAxes = {{{0, 0, 0}, {0, 0, 1}}, {{0, 0, 0}, {0, 1, 0}}, {{0, 0,
0}, {1, 0, 0}}};
Graphics3D[{{#1, #2, Line##3} & ### Transpose#{colors, style, cAxes},
Blue, Specularity[White, 3], Sphere[{.5, .5, .5}, .1]},
Boxed -> False, FaceGrids -> All,
FaceGridsStyle -> Directive[Black, Dashed]]
Using Yoda`s solution on How to Style Lines
How could I color the Sphere using GrayLevel (I will manipulate it later).
And How could I have denser FaceGrids ? 10 Lines horizontally & Vertically. I also don`t understand why the Edges one are distant to one another.
It's always good practice to group the graphics object and its styles in a list, in case you need to quickly add another one with different styles. By that, I mean write it as {Blue, Specularity[White, 3], Sphere[{.5, .5, .5}, .1]}. Now you can easily add a GrayLevel term before Sphere and it'll work.
For the FaceGrids, I believe you'll have to manually define the lines at your desired spacing for each face. Here's an example for showing how to do it for one face.
Graphics3D[{{#1, #2, Line##3} & ###
Transpose#{colors, style, cAxes}, {Blue, GrayLevel[0.3], Lighting -> "Neutral",
Specularity[White, 3], Sphere[{.5, .5, .5}, .1]}}, Boxed -> False,
FaceGrids -> {{{0, 0, 1},
Transpose#({#, #} & /# Range[0, 1, 0.1])}},
FaceGridsStyle -> Directive[Black, Dashed]]
The faces are defined as ±1 for the corresponding plane and the other two are zero. So {0,0,1} in my example corresponds to the z=1 plane.
The list supplied to FaceGrids can be easily computed for each face, instead of manually entering them, but I'll leave that to you :)
EDIT:
Since you want a uniform mesh all around, define where you want the grid lines drawn as
gridList = Transpose#({#, #} & /# Range[0, 1, 0.1]);
Then, use the following for FaceGrids:
FaceGrids -> Join ## Table[{RotateLeft[j {0, 0, 1}, i], gridList},
{i, {0, 1, 2}}, {j, {-1, 1}}]
Here's how the result should look like with PlotRangePadding -> None:
In addition to Yoda's response:
Lighting -> "Neutral" will allow grayscale object to show up as gray instead of with various colors.
PlotRangePadding -> None will remove the spaces on the grid lines (depending on the setting for PlotRange.)
Yoda beat me to typing out the FaceGrids setting (see documentation). But here is an alternative.
Instead of setting the FaceGrids setting explicitly, youcould also try setting FrameTicks, since by default the FaceGrids follow these, and then style the FrameTicks to be invisible using Opacity.
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.