Smooth 4D (3D + color) plot from discrete points

Question

I have a file containing isosurface $\{x,y,z,F\}$ data (around 9000 points). My goal is to generate a smooth (NOT a discrete set of points!) colored surface using ListContourPlot3D, i.e., something like this:

More specifically, the surface I am trying to plot is closed.

This what I am getting if I plot x,y,z:

Now, I want to add color on top, i.e., I want different regions of the surface to be colored differently depending F.

I am using ListContourPlot3D, because according to the description this what I need:

ListContourPlot3D linearly interpolates values to give smooth contours

Any hints? So far all my attempts have been unsuccessful.

This is what I am getting with ListContourPlot3D[data]:

EDIT: attached the file.

file

I want to plot col. 1(x): col.2(y): col.3(z) col4(color)

Answer 1

ListContourPlot3D does work as intended. Please check its documentation on what it is supposed to do. To make this kind of plot you need ListSurfacePlot3D.

data = Import["~/Downloads/furan-ks.sdat", "Table"];

nf = Nearest[data[[All, {1, 2, 3}]] -> Rescale[data[[All, 4]]]]

colfun = ColorData["Rainbow"]@First@nf[{#1,#2,#3}]&

ListSurfacePlot3D[
 data[[All, {1, 2, 3}]],
 BoxRatios -> Automatic,
 ColorFunction -> colfun,
 ColorFunctionScaling -> False
 ]

You can experiment with the MaxPlotPoints option (e.g. set it to 20) to get the optimal surface fitting to your points. A too tight fit will be noisy, a too loose one will look chunky.

The tricky bit here was converting the colour data into a format usable with ListSurfacePlot3D. This is a non-trivial step. I used Nearest to create a function (named nf) that takes a 3D coordinate and returns the colour value of the closest point from the dataset. Then I converted this value to an actual colour (i.e. an RGBColor object) using the function colfun.

Answer 2

Using @Szabolcs's colfun with ListContourPlot3D and ListSurfacePlot3D give similar images:

opts = {BoxRatios -> Automatic, ColorFunction -> colfun, 
        Lighting -> "Neutral", ColorFunctionScaling -> False,   ImageSize -> 400};

Row[{ListContourPlot3D[data[[All, {1, 2, 3}]], opts, Contours -> {0}],
     ListSurfacePlot3D[data[[All, {1, 2, 3}]], opts]}]

Answer 3

ListContourPlot3D has a VERY nasty default option; it joins the points creating a surface, not discrete 3D points and this feature cannot be removed. In order to deal with this we have to come up with a radical solution like the following:

First of all, let's read the data file

data = ReadList["data.out", Number, RecordLists -> True];

I suppose that the fourth column corresponds to the value of an index so, let's find out the minimum and the maximum values of that index in our sample data file

datat = Table[data[[i, 4]], {i, 1, Length[data]}];
min = Min[datat];
max = Max[datat];
Print["min = ", min]
Print["max = ", max]

Now let's paint the 3D points with colors according to the values of the index

valrange = {min, max};
data[[All, 4]] = Rescale[data[[All, 4]], valrange];
colfunc[x_, cf_] := ColorData[cf][1 - x[[4]]];

and then plot them

S0 = Graphics3D[{PointSize[0.004], Point[#[[1 ;; 3]], VertexColors -> colfunc[#, "Rainbow"]] & /@ data}]

If we like we can also create a custom-made colorbar

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
Frame -> True, FrameLabel -> {{None, "index"}, {None, None}}, 
LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
FrameTicks -> {{None, All}, {None, None}}, 
FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain], 
ColorFunction -> colorFunction]

and combine the colorbar with the previous 3D plot

With[{opts = {ImageSize -> {Automatic, 600}}, cf = "Rainbow"}, 
Row[{Show[{S0}, Axes -> True, 
AxesStyle -> Directive[FontSize -> 18, FontFamily -> "Helvetica"],
AxesLabel -> {"x", "y", "z"}, BoxRatios -> {1, 1, 1}, opts], 
Show[colorbar[valrange, ColorData[cf][1 - #] &], 
ImagePadding -> {{20, 60}, {55, 25}}, opts]}]]