Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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:

Bessel Beam Focusing

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...

share|improve this question
3  
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

1 Answer 1

up vote 4 down vote accepted

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: enter image description here

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

share|improve this answer
    
+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

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.