# Volumetric Rendering of cylinder symmetric radial image

I would like to render a cylinder symmetric radial cross-section with Image3D. As an example one could use the propagation of a Bessel Beam through a Lens:

Here the cylinder axis is the bottom of the image and the radial coordinate is along the vertical direction of the image. A 3D volumetric rendering would show the resulting focus ring at a radius of 1mm very nicely. My solution is very slow and uses a tomographical approach by generating array plots of rotated image rows and stacking them together in Image3D.

inpdata =
ImageData[
Import[NotebookDirectory[] <> "<Filename of image to rotate>.png"]][[;; , ;; , 1]];
outdata =
Monitor[Table[tint = Interpolation[Reverse[1 - inpdata[[;; , i]]]];
Image[ArrayPlot[
Table[Piecewise[{{tint[Sqrt[x^2 + y^2]],
Sqrt[x^2 + y^2] < Length[inpdata]}},
0], {x, -Length[inpdata],
Length[inpdata]}, {y, -Length[inpdata], Length[inpdata]}],
Frame -> False, ImageMargins -> None,
ColorFunctionScaling -> False]], {i, 1, Dimensions[inpdata][[2]], 1}], i];
Image3D[outdata]


I hope that there is a more efficient way to do this in Mathematica...

• You haven't given us very much to work with. What are the coordinate transformations that you want to plot? What are the inputs and expected outputs? Can you show us code that you have tried? – bill s Jun 21 '13 at 7:44
• This could be an interesting question, but as bill said, you need to show more effort you made (especially with Mathematica) and give us a concrete start point (sample data, demonstration of expected output, etc.). – Silvia Jun 21 '13 at 9:33
• Fair comment, I thought that my question was clear enough. Anyway I included my clumsy solution, which is not really very elegant but yields a very nice result with my example image above. – Rainer Jun 21 '13 at 11:53
• A warning to those wanting to play around with the code, it takes a very long time. It's probably best to use a much smaller test image. – shrx Jun 21 '13 at 12:50

Here is my solution using RevolutionPlot3D to draw the disk layers, it's faster; First convert the image to data rows:

imgd = Map[First[#] &,
ImageData[ColorConvert[img, "Grayscale"]], {2}];
rows = Reverse /@ Transpose[imgd];


Define the function to draw the disk slices:

ClearAll[disk]
disk[row_List, nPoints_] := Module[{
lr = Length[row]},
RevolutionPlot3D[
Clip[Interpolation[row][x + 1], {0, 1}], {x, 0, lr - 1},
Mesh -> False,
ColorFunction -> Function[{x, y, z}, GrayLevel[1 - z]],
PlotRange -> {All, All, {0, 1}}, ColorFunctionScaling -> False,
Lighting -> {{"Ambient", White}}, Background -> Black,
Boxed -> False, Axes -> False, PlotRangePadding -> None,
ViewPoint -> {0, 0, Infinity}, PlotPoints -> nPoints]]


Create the 3D image:

Image3D[Image[disk[#, 30], ColorSpace -> "Grayscale"] & /@ rows,
Background -> LightBlue,
BoxRatios -> {1, 1, 1},
ColorFunction -> "XRay", Boxed -> True]


Result:

Edit: see reference page of Image3D for more useful ColorFunction parameters and see which works best for you. "WhiteBlackOpacity" is also nice.

• +1 for using RevolutionPlot3D, which is what I'll try. – Silvia Jun 21 '13 at 16:23
• Great answer, it's a significant speedup compared to my solution. However to get a similiar resolution as in my post you need to change PlotPoints to about 70 instead of 30 like in the post of shrx. In this case the speedup is about 5x. Thanks for the solution... – Rainer Jun 22 '13 at 13:23