Image3D and Graphics3D

Question

also I guess that the topic was tackled in Combining Image3D and Graphics3D. My question is quite similar: How do I match the coordinate Systems of Graphics3D and Image3D?

Here some code:

z = 1;
p = RandomInteger[100, {z, 3}];
r = RandomInteger[10, {z}];
spheres = MapThread[RotateLeft[DiskMatrix[#1, {100, 100, 100}], #2] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True, AxesLabel -> {"x", "y", "z"}]
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj,
                Axes -> True,
                AxesLabel -> {"x", "y", "z"},
                PlotRange -> {{0, 100}, {0, 100}, {0, 100}}]
Show[i, gr, Axes -> True]

Can anyone explain to me how to match the coordinate systems, that the spheres match?

Thanks in advance!

Answer 1

Firstly, you need to apply {50,50,50} shift to DiskMatrix. It is because DiskMatrix produces sphere with the center at {50,50,50}.

Image3D has different axes directions than Graphics3D so you need to search through numerous variants of transpositions and reflections. I found the following combination:

z = 10;
p = RandomInteger[100, {z, 3}];
r = RandomInteger[10, {z}];

spheres = 
  MapThread[
   Transpose[#, {3, 2, 1}] &@Reverse@RotateLeft[
       DiskMatrix[#1, {100, 100, 100}], #2 - {50, 50, 50}] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True, 
   AxesLabel -> {"x", "y", "z"}];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"}, 
   PlotRange -> {{0, 100}, {0, 100}, {0, 100}}];
Show[i, gr, Axes -> True]

Answer 2

This still may be considered a duplicate, but it's also possible that there is something odd happening with the formation of spheres. A set of geometric transformations (rotations, reflections and finally a scaling) gives close to overlap. Note I got rid of the randomness to make this problem a bit easier to navigate and did not nest the GeometricTransformations so that each one could be visualized if desired.

z = 5;
p = {{50, 50, 50}, {10, 10, 10}, {90, 90, 10}, {90, 10, 90}, {10, 90, 
    90}};
r = {2, 4, 6, 8, 10};
spheres = 
  MapThread[RotateLeft[DiskMatrix[#1, {100, 100, 100}], #2] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True, 
   AxesLabel -> {"x", "y", "z"}];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"}, 
   PlotRange -> {{0, 100}, {0, 100}, {0, 100}}];
objreflected = 
  GeometricTransformation[obj, 
   ReflectionTransform[{0, 0, 1}, {50, 50, 50}]];
objrotated = GeometricTransformation[
   GeometricTransformation[objreflected, 
    RotationTransform[180 Degree, {1, 0, 0}, {50, 50, 50}]],
   RotationTransform[100 Degree, {0, 1, 0}, {50, 50, 50}]];
objscaled = 
  GeometricTransformation[objrotated, 
   ScalingTransform[{0.4, 0.4, 0.4}, {50, 50, 50}]];
Show[i, Graphics3D@objscaled]

Why the central sphere gets blown up in the image3d portion of the graphic is beyond me.

Answer 3

This may not answer your question.

I don't quite understand how you built the Image3D object. I notice that the sphere doesn't seem to go where you put the points. For example, if I put the point right in the middle of the coordinate system, they end up out at the corners

p = {{50, 50, 50}};
r = {10};
spheres = 
  MapThread[RotateLeft[DiskMatrix[#1, {100, 100, 100}], #2] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True, 
   AxesLabel -> {"x", "y", "z"}, ImageSize -> 300];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"}, 
   PlotRange -> {{0, 100}, {0, 100}, {0, 100}}, ImageSize -> 300];
Grid[{{i, 
   gr}, {Show[i, gr, Axes -> True, ImageSize -> 300, 
    AxesLabel -> {"x", "y", "z"}], SpanFromLeft}}]

So if I try to recreate what I think you are going for, I do the following

p1 = N[p[[1]]];
r1 = N[r[[1]]];
table = Table[
   If[EuclideanDistance[{x, y, z}, p1] <= r1, 1, 0], {z, 100}, {y, 
    100}, {x, 100}];
i2 = Image3D[table, Axes -> True, AxesLabel -> {"x", "y", "z"}]

Looks good, but if you try to use a less symmetric point as the center of the sphere, it gets all wonky (that's a technical term).

p1 = {10.0, 20.0, 30.0};
r1 = N[r[[1]]];
table = Table[
   If[EuclideanDistance[{x, y, z}, p1] <= r1, 1, 0], {z, 100}, {y, 
    100}, {x, 100}];

i2 = Image3D[table, Axes -> True, AxesLabel -> {"x", "y", "z"}]

I don't understand why, but the only way I can get Image3D to work is to apply Reverse to two of the axes. The following works:

z = 1;
p = RandomInteger[100, {z, 3}];
r = RandomInteger[10, {z}];
i = Module[{p1, r1, table},
   p1 = N[p[[1]]];
   r1 = N[r[[1]]];
   table = 
    Table[If[EuclideanDistance[{x, y, z}, p1] <= r1, 1, 0], {z, 
      100}, {y, 100}, {x, 100}];
   Image3D[Reverse[table, {1, 2}], Axes -> True, 
    AxesLabel -> {"x", "y", "z"}]];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"}, 
   PlotRange -> {{0, 100}, {0, 100}, {0, 100}}];
Show[i, gr, Axes -> True]

To me, Image3D is too buggy to use. Half the time I try to do something with it, it crashes my kernel. I want there to be a cool ListDensityPlot3D function, but I'll have to wait I think.