Skip to main content

plotting - Using Inset[..] to overlay a Graphics3D with its raster version


Preamble


First let me explain the why. You can skip this and go directly to the question if want to answer it right away. We had more than one discussion about how to produce nice looking 3d plots which can be exported to pdf or some other vector format. Some details why this is not really possible are explained in a post of mine in the question Exporting graphics to PDF - huge file.

To solve this issue, there is in my opinion a lot of work to do, since to make it really fancy one would have to reimplement the rendering and 2d-projection process which is done by Mathematica when it displays a Graphics3D.
A simple solution, which is maybe OK in a lot of cases, would be to separate the surface of a 3d plot from its box, labels and axes. Then one could create a high-resolution image of the surface and combine this again with the (still in vector format and infinitely high resolved) axes and labels. I showed in the linked post how to do this.
To make this working reliable one has to ensure, that it is possible to place the surface which is now a raster image at the exact same position where the original surface was before. To place the image Wolfram gave us Inset at hand which kind of does a good job, but when you look at it closely, there is some behavior I don't understand.


Question


Please consider the following two Plot3D where I tried to deny any padding, margin or whatsoever. One plot is rasterized and I fixed the ImageSize so that the outcome should be completely equal


s = {300, 300};
opts = {ImageSize -> s,
   PlotStyle -> None,
   PlotRangePadding -> None,
   ImagePadding -> None,

   ImageMargins -> None,
   Axes -> False,
   Boxed -> False};
gr1 = Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2},
   PlotStyle -> None,
   Evaluate[Sequence @@ opts]
   ];
img1 =
  Rasterize[
   Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2},

    PlotStyle -> Opacity[0.4],
    Evaluate[Sequence @@ opts]
    ],
   "Image",
   Background -> None,
   ImageSize -> s,
   RasterSize -> s
   ];

If you like, use Framed to put a frame around both graphics and try to see differences in placement or size. I could not find any. Creating now a combined Graphics3D with Inset where I used the AbsoluteOptions of gr1 for the graphics does show, that the inset graphics is not correctly placed. I could have used Show for the joining, the outcome would have been the same. Please note, that I initialized the variables {dx,dy,dz} to values which give a nice match on my machine. The image shows the zero position.



Manipulate[
 Graphics3D[{Inset[img1, {dx, dy, dz}], First[gr1]}, 
  AbsoluteOptions[gr1]],
 {{dx, -0.13`}, -.4, .4},
 {{dy, -0.14`}, -.4, .4},
 {{dz, -0.375`}, -.4, .4}
]

enter image description here


Can someone explain or solve this problem? Maybe someone has an idea where exactly these offsets come from.



Solution


It's worth looking at every answer below, because there are many valuable information, but the key point to the solution of my question was given by Heike who noticed, that the explicit setting of SphericalRegion influences the correct placement.


Nevertheless, working with Rasterize, ImageSize, ImageResolution, RasterSize and all the options influencing margins and paddings around graphics often leads to surprising results. So be warned.


With SphericalRegion->True in the plot commands, I could quite reliable create nice pdf's from various Graphics3D. Here the creation of a high-resolution pdf which has a filesize of 860Kb.


I have not included an image, because the png image comes not even close to how brilliant this looks in the pdf. Try it!


RasterizedGraphics3D[gr_Graphics3D, rastersize_Integer] := 
  Module[{dim = ImageDimensions[gr], factor},
   factor = rastersize/First[dim];
   Graphics3D[{Inset[
      GaussianFilter[

       Rasterize[Show[gr,
         Boxed -> False, Axes -> False, AbsoluteOptions[gr]],
        "Image", Background -> None, RasterSize -> factor*dim],
       .5 factor
       ],
      {0, 0, 0}, {Center, Center}, dim]},
    AbsoluteOptions[gr]]
   ];

grout = RasterizedGraphics3D[

  Plot3D[Im[ArcSin[(x + I y)^4]], {x, -2, 2}, {y, -2, 2}, 
   Mesh -> None, 
   PlotStyle -> 
    Directive[Yellow, Specularity[White, 20], Opacity[0.8]], 
   ExclusionsStyle -> {None, Red}, SphericalRegion -> True], 2400]
Export["tmp/tmp.pdf", grout, "AllowRasterization" -> False]

The GaussianFilter does basically antialiasing because it smooths the high-res raster-image version of the surface a bit. Thank's for all the answers and comments.



Answer



It seems that if you use Options[gr1] instead of AbsoluteOptions[gr1] and an offset of {dx, dy, dz} == {0,0,0} the two graphs align perfectly:



s = {300, 300};
opts = {ImageSize -> s, PlotStyle -> None, PlotRangePadding -> None, 
   ImagePadding -> None, ImageMargins -> None, Axes -> False, Boxed -> False};
gr1 = Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, PlotStyle -> None, 
     Mesh -> None, Boxed -> True, ##] & @@ opts;
img1 = Rasterize[Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, 
      PlotStyle -> Opacity[.5], ##] & @@ opts, "Image", 
   Background -> None, ImageSize -> s, RasterSize -> s];

Graphics3D[{Inset[img1, {0, 0, 0}], First[gr1]}, Options[gr1]]


Mathematica graphics


The next question is then what setting in AbsoluteOptions[gr1] causes the two graphs to misalign. After a bit of experimentation it turns out that the culprit is SphericalRegion. If this option is not set explicitly AbsoluteOptions[gr1, SphericalRegion] returns False by default but the actual setting used is the value of SphericalRegion in the $FrontEnd option Graphics3DBoxOptions. You can check this setting with


CurrentValue[$FrontEnd, {Graphics3DBoxOptions, SphericalRegion}]

Comments

Post a Comment

Popular posts from this blog

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...
Post a Comment
Read more

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

What is and isn't a valid variable specification for Manipulate?

I have an expression whose terms have arguments (representing subscripts), like this: myExpr = A[0] + V[1,T] I would like to put it inside a Manipulate to see its value as I move around the parameters. (The goal is eventually to plot it wrt one of the variables inside.) However, Mathematica complains when I set V[1,T] as a manipulated variable: Manipulate[Evaluate[myExpr], {A[0], 0, 1}, {V[1, T], 0, 1}] (*Manipulate::vsform: Manipulate argument {V[1,T],0,1} does not have the correct form for a variable specification. >> *) As a workaround, if I get rid of the symbol T inside the argument, it works fine: Manipulate[ Evaluate[myExpr /. T -> 15], {A[0], 0, 1}, {V[1, 15], 0, 1}] Why this behavior? Can anyone point me to the documentation that says what counts as a valid variable? And is there a way to get Manpiulate to accept an expression with a symbolic argument as a variable? Investigations I've done so far: I tried using variableQ from this answer , but it says V[1...
Post a Comment
Read more