Skip to main content

plotting - How to visualize the interior of a complicated 3D plot



I have an external data file (can be downloaded here: link 1 or link 2) which contains a dense grid of initial condition in the (x,y,z) space. I read it with Mathematica and plot these initial conditions with different colors according to some specific properties


m = Import["data_3d.out", "Table"];

getColor[m_List, i_Integer] :=
Module[{s = m[[i, 6]]},
Which[s == 0, Black, s == 1, Red, s == 2, Darker[Green], s == 3,
Brown, s == 4, Blue, s == 5, Orange, s == 6, Cyan, s == 7,
Magenta, s == 8, Yellow, True, White]];

data = Table[{PointSize[0.004], getColor[m, i],

Point[{m[[i, 1]], m[[i, 2]], m[[i, 3]]}]}, {i, 1, Length[m]}];

P0 = Graphics3D[data, Axes -> True, BoxRatios -> {1, 1, 1},
PlotRange -> 6, ImageSize -> 550]

and here is the output


enter image description here


We observe, that several color patterns appear but we can see only the surface of the three-dimensional grid. So, the question:


Is there a way to penetrate inside the 3d surface and visualize how these color patterns are? Any suggestions?


Please, us the original data file for testing. I think, generating simpler but random 3d grids in this case, could be very illusive since all the story is about the color patterns that appear and obviously cannot be replicated randomly.



EDIT


A second working link for retrieving the data file is added.



Answer



A tomographic approach:


m = Import["http://www.datafilehost.com/get.php?file=3c69e895", "Data"];

getColor[s_List] :=
Replace[s, {0 -> Black, 1 -> Red, 2 -> Darker[Green], 3 -> Brown,
4 -> Blue, 5 -> Orange, 6 -> Cyan, 7 -> Magenta,
8 -> Yellow, _ -> White}, 1];


nfx = Nearest[m[[All, 1]] -> m];

Manipulate[
Graphics3D[{PointSize[0.004],
Point[#[[All, 1 ;; 3]], VertexColors -> getColor[#[[All, 6]]]] &@ nfx[x0]},
Axes -> True, BoxRatios -> {1, 1, 1}, PlotRange -> 6, ImageSize -> 350],
{x0, Min[m[[All, 1]]], Max[m[[All, 1]]]}
]


Manipulate output


Other ways of slicing:


nfy = Nearest[m[[All, 2]] -> m];
nfz = Nearest[m[[All, 3]] -> m];



In response to a comment, here is a static approach:


xlist = Range[0, 5, 1]

Graphics3D[{PointSize[0.004],

Point[#[[All, 1 ;; 3]], VertexColors -> getColor[#[[All, 6]]]] &@
Flatten[nfx /@ xlist, 1]}, Axes -> True, BoxRatios -> {1, 1, 1},
PlotRange -> 6, ImageSize -> 350]

(* {0, 1, 2, 3, 4, 5} *)

Mathematica graphics


Comments