# random discrete data 3D plot

I get the random discrete data as follows

data={{65, 5, 0.1}, {70, 5, 0.1}, {75, 5, 0.1}, {80, 5, 0.1}, {70, 10,
0.1}, {75, 10, 0.1}, {80, 10, 0.1}, {70, 15, 0.1}, {75, 15,
0.1}, {80, 15, 0.1}, {75, 20, 0.1}, {80, 20, 0.1}, {75, 25,
0.1}, {80, 25, 0.1}, {80, 30, 0.1}, {80, 35, 0.1}, {55, 5,
0.2}, {60, 5, 0.2}, {65, 5, 0.2}, {70, 5, 0.2}, {75, 5, 0.2}, {80,
5, 0.2}, {60, 10, 0.2}, {80, 10, 0.2}, {65, 15, 0.2}, {80, 15,
0.2}, {65, 20, 0.2}, {80, 20, 0.2}, {70, 25, 0.2}, {80, 25,
0.2}, {75, 30, 0.2}, {80, 30, 0.2}, {75, 35, 0.2}, {80, 35,
0.2}, {80, 40, 0.2}, {45, 5, 0.3}, {50, 5, 0.3}, {55, 5, 0.3}, {60,
5, 0.3}, {65, 5, 0.3}, {70, 5, 0.3}, {75, 5, 0.3}, {80, 5,
0.3}, {50, 10, 0.3}, {80, 10, 0.3}, {55, 15, 0.3}, {80, 15,
0.3}, {60, 20, 0.3}, {80, 20, 0.3}, {65, 25, 0.3}, {80, 25,
0.3}, {70, 30, 0.3}, {80, 30, 0.3}, {75, 35, 0.3}, {80, 35,
0.3}, {75, 40, 0.3}, {80, 40, 0.3}, {40, 5, 0.4}, {45, 5, 0.4}, {50,
5, 0.4}, {55, 5, 0.4}, {60, 5, 0.4}, {65, 5, 0.4}, {70, 5,
0.4}, {75, 5, 0.4}, {80, 5, 0.4}, {45, 10, 0.4}, {80, 10, 0.4}, {50,
15, 0.4}, {80, 15, 0.4}, {55, 20, 0.4}, {80, 20, 0.4}, {60, 25,
0.4}, {80, 25, 0.4}, {65, 30, 0.4}, {80, 30, 0.4}, {70, 35,
0.4}, {80, 35, 0.4}, {75, 40, 0.4}, {80, 40, 0.4}, {35, 5,
0.5}, {40, 5, 0.5}, {45, 5, 0.5}, {50, 5, 0.5}, {55, 5, 0.5}, {60,
5, 0.5}, {65, 5, 0.5}, {70, 5, 0.5}, {75, 5, 0.5}, {80, 5,
0.5}, {40, 10, 0.5}, {80, 10, 0.5}, {45, 15, 0.5}, {80, 15,
0.5}, {50, 20, 0.5}, {80, 20, 0.5}, {55, 25, 0.5}, {80, 25,
0.5}, {60, 30, 0.5}, {80, 30, 0.5}, {65, 35, 0.5}, {80, 35,
0.5}, {70, 40, 0.5}, {75, 40, 0.5}, {80, 40, 0.5}, {30, 5,
0.6}, {35, 5, 0.6}, {40, 5, 0.6}, {45, 5, 0.6}, {50, 5, 0.6}, {55,
5, 0.6}, {60, 5, 0.6}, {65, 5, 0.6}, {70, 5, 0.6}, {75, 5,
0.6}, {80, 5, 0.6}, {30, 10, 0.6}, {80, 10, 0.6}, {40, 15,
0.6}, {80, 15, 0.6}, {45, 20, 0.6}, {80, 20, 0.6}, {50, 25,
0.6}, {80, 25, 0.6}, {55, 30, 0.6}, {80, 30, 0.6}, {60, 35,
0.6}, {80, 35, 0.6}, {65, 40, 0.6}, {70, 40, 0.6}, {75, 40,
0.6}, {80, 40, 0.6}, {20, 5, 0.7}, {25, 5, 0.7}, {30, 5, 0.7}, {35,
5, 0.7}, {40, 5, 0.7}, {45, 5, 0.7}, {50, 5, 0.7}, {55, 5,
0.7}, {60, 5, 0.7}, {65, 5, 0.7}, {70, 5, 0.7}, {75, 5, 0.7}, {80,
5, 0.7}, {25, 10, 0.7}, {80, 10, 0.7}, {30, 15, 0.7}, {80, 15,
0.7}, {40, 20, 0.7}, {80, 20, 0.7}, {45, 25, 0.7}, {80, 25,
0.7}, {50, 30, 0.7}, {80, 30, 0.7}, {55, 35, 0.7}, {80, 35,
0.7}, {65, 40, 0.7}, {70, 40, 0.7}, {75, 40, 0.7}, {80, 40,
0.7}, {15, 5, 0.8}, {20, 5, 0.8}, {25, 5, 0.8}, {30, 5, 0.8}, {35,
5, 0.8}, {40, 5, 0.8}, {45, 5, 0.8}, {50, 5, 0.8}, {55, 5,
0.8}, {60, 5, 0.8}, {65, 5, 0.8}, {70, 5, 0.8}, {75, 5, 0.8}, {80,
5, 0.8}, {20, 10, 0.8}, {80, 10, 0.8}, {25, 15, 0.8}, {80, 15,
0.8}, {30, 20, 0.8}, {80, 20, 0.8}, {35, 25, 0.8}, {80, 25,
0.8}, {45, 30, 0.8}, {80, 30, 0.8}, {50, 35, 0.8}, {80, 35,
0.8}, {55, 40, 0.8}, {60, 40, 0.8}, {65, 40, 0.8}, {70, 40,
0.8}, {75, 40, 0.8}, {80, 40, 0.8}, {10, 5, 0.9}, {15, 5, 0.9}, {20,
5, 0.9}, {25, 5, 0.9}, {30, 5, 0.9}, {35, 5, 0.9}, {40, 5,
0.9}, {45, 5, 0.9}, {50, 5, 0.9}, {55, 5, 0.9}, {60, 5, 0.9}, {65,
5, 0.9}, {70, 5, 0.9}, {75, 5, 0.9}, {80, 5, 0.9}, {10, 10,
0.9}, {15, 10, 0.9}, {20, 10, 0.9}, {25, 10, 0.9}, {30, 10,
0.9}, {35, 10, 0.9}, {40, 10, 0.9}, {45, 10, 0.9}, {50, 10,
0.9}, {55, 10, 0.9}, {60, 10, 0.9}, {65, 10, 0.9}, {70, 10,
0.9}, {75, 10, 0.9}, {80, 10, 0.9}, {15, 15, 0.9}, {20, 15,
0.9}, {25, 15, 0.9}, {30, 15, 0.9}, {35, 15, 0.9}, {40, 15,
0.9}, {45, 15, 0.9}, {50, 15, 0.9}, {55, 15, 0.9}, {60, 15,
0.9}, {65, 15, 0.9}, {70, 15, 0.9}, {75, 15, 0.9}, {80, 15,
0.9}, {20, 20, 0.9}, {25, 20, 0.9}, {30, 20, 0.9}, {35, 20,
0.9}, {40, 20, 0.9}, {45, 20, 0.9}, {50, 20, 0.9}, {55, 20,
0.9}, {60, 20, 0.9}, {65, 20, 0.9}, {70, 20, 0.9}, {75, 20,
0.9}, {80, 20, 0.9}, {25, 25, 0.9}, {30, 25, 0.9}, {35, 25,
0.9}, {40, 25, 0.9}, {45, 25, 0.9}, {50, 25, 0.9}, {55, 25,
0.9}, {60, 25, 0.9}, {65, 25, 0.9}, {70, 25, 0.9}, {75, 25,
0.9}, {80, 25, 0.9}, {35, 30, 0.9}, {40, 30, 0.9}, {45, 30,
0.9}, {50, 30, 0.9}, {55, 30, 0.9}, {60, 30, 0.9}, {65, 30,
0.9}, {70, 30, 0.9}, {75, 30, 0.9}, {80, 30, 0.9}, {40, 35,
0.9}, {45, 35, 0.9}, {50, 35, 0.9}, {55, 35, 0.9}, {60, 35,
0.9}, {65, 35, 0.9}, {70, 35, 0.9}, {75, 35, 0.9}, {80, 35,
0.9}, {45, 40, 0.9}, {50, 40, 0.9}, {55, 40, 0.9}, {60, 40,
0.9}, {65, 40, 0.9}, {70, 40, 0.9}, {75, 40, 0.9}, {80, 40, 0.9}}
ListPointPlot[data]


I get this

Image Missing

Then,I use ListSurfacePlot[data], but the result is wrong. I want to get a 3D plot like RegionPlot3D

Edit graphic representation:

 Graphics3D[{PointSize[.01], Hue[#[[3]]], Point[# {1, 1, 10} ]} & /@ data]


• Try ListPlot3D. – David G. Stork Apr 8 '15 at 16:49
• I pasted in a Graphic3D figure just so folks can see what the data looks like... – george2079 Apr 8 '15 at 18:30
• Do you get what you need with ListPointPlot3D[data] or ListPlot3D[data] or ListSurfacePlot3D[data, BoxRatios -> {1, 1, 1/3}]? – kglr Apr 8 '15 at 18:46

# Motivation

The following gives some idea of what the data looks like:

Graphics3D[
Polygon /@ (Module[
{center, pts},
pts = #;
center = Mean[pts];
SortBy[pts, (N[ArcTan @@ Most[# - center]] &)]
] &) /@ GatherBy[data, #[[3]] &],
Axes -> True,
Boxed -> True,
BoxRatios -> {1, 1, 1},
ViewPoint -> 1000 {1, 1, 1}
]


For each $z$-layer, I have connected all points to created a non-self-intersecting polygon (with codes adapted from #48091).

The result makes clear that the top and bottom $z$-layers have points on both the boundary and inside. The inner $z$-layers have points on the boundary only.

Likewise for the $x$-layers:

Graphics3D[
Polygon /@ (Module[
{center, pts},
pts = #;
center = Mean[pts];
SortBy[pts, (N[ArcTan @@ Rest[# - center]] &)]
] &) /@ GatherBy[data, #[[1]] &],
Axes -> True,
Boxed -> True,
BoxRatios -> {1, 1, 1},
ViewPoint -> 1000 {1, 1, 1}
]


and $y$-layers:

Graphics3D[
Polygon /@ (Module[
{center, pts},
pts = #;
center = Mean[pts];
SortBy[pts, (N[ArcTan @@ Drop[# - center, {2}]] &)]
] &) /@ GatherBy[data, #[[2]] &],
Axes -> True,
Boxed -> True,
BoxRatios -> {1, 1, 1},
ViewPoint -> 1000 {1, 1, 1}
]


All three layers together:

What you want is a concave hull. Let me present two approaches.

# Approach 1

Because, as shown by the layers above, your points come in discrete cubic cells, each cell has a convex hull constructed from the data points it contains. The concave hull can be constructed my merging these cellular convex hulls.

My procedure is as follows.

1. Your data is separated into layers in each direction.
2. Each consecutive layers are formed into a 3D region (DelaunayMesh) bounded by a convex hull (xstrips and so on).
3. Cubic regions (cuboids) are generated by partitioning points (pts) in the bounding box of your data.
4. The points in the bounding box are chosen for the construction of the convex hulls only if they are in a region in which xstrips, ystrips, and zstrips intersect (soliddata).
5. The chosen points (soliddata) within each of the cuboids are made into convex hulls.
6. Polygon faces from all the hulls are collected together into the final result.

Below is the code:

data = Rationalize /@ data;
xlayers = (Module[
{center, pts},
pts = #;
center = Mean[pts];
SortBy[pts, (N[ArcTan @@ Rest[# - center]] &)]
] &) /@ Select[GatherBy[data, #[[1]] &], Length@# > 2 &];
ylayers = (Module[
{center, pts},
pts = #;
center = Mean[pts];
SortBy[pts, (N[ArcTan @@ Drop[# - center, {2}]] &)]
] &) /@ Select[GatherBy[data, #[[2]] &], Length@# > 2 &];
zlayers = (Module[
{center, pts},
pts = #;
center = Mean[pts];
SortBy[pts, (N[ArcTan @@ Most[# - center]] &)]
] &) /@ Select[GatherBy[data, #[[3]] &], Length@# > 2 &];
xstrips = DelaunayMesh[Level[#, {-2}]] & /@ Partition[xlayers, 2, 1];
ystrips = DelaunayMesh[Level[#, {-2}]] & /@ Partition[ylayers, 2, 1];
zstrips = DelaunayMesh[Level[#, {-2}]] & /@ Partition[zlayers, 2, 1];
xs = Range[Min[#[[1]] & /@ data], Max[#[[1]] & /@ data], 5];
ys = Range[Min[#[[2]] & /@ data], Max[#[[2]] & /@ data], 5];
zs = Range[Min[#[[3]] & /@ data], Max[#[[3]] & /@ data], 1/10];
pts = Table[
{x, y, z},
{x, xs}, {y, ys}, {z, zs}
];
partitions = Partition[pts, {2, 2, 2}, 1];
cellpoints = Flatten[#, 2] & /@ Level[partitions, {-5}];
cuboids = Cuboid[First@Sort[#], Last@Sort[#]] & /@ cellpoints;
ptsflat = Level[pts, {-2}];
soliddata = Select[
ptsflat,
Function[
p,
AllTrue[
{xstrips, ystrips, zstrips},
Function[strip, AnyTrue[strip, RegionMember[#, p] &]]
]
]
];
hullpoints = Function[p, Select[soliddata, RegionMember[p, #] &]] /@ cuboids;
realhullpoints = Select[hullpoints, Length@# > 3 &];
hulls = DeleteCases[ConvexHullMesh /@ realhullpoints, _EmptyRegion];
polygons = MeshPrimitives[#, 2] & /@ hulls;
Graphics3D[
{
EdgeForm[{Thin, Opacity[1/30, Black]}],
polygons
},
AxesLabel -> {"x", "y", "z"},
Axes -> True,
Boxed -> False,
BoxRatios -> {1, 1, 1},
ViewPoint -> 1000 {-1, 1, -1}
]


# Approach 2

You can also try what's described here: #8753. We don't actually need to explicitly load TetGenLink in Mathematica 10 as many of the needed functions have been incorporated into the Wolfram Language.

tetrahedra = Level[MeshPrimitives[DelaunayMesh[data], 3], {-3}];
alphashape[rmax_] := Pick[tetrahedra, radii, r_ /; r < rmax]
faces[tetras_] := Flatten[
tetras /. {a_, b_, c_, d_} :> {{a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}},
1
];
externalfaces[faces_] := Cases[Tally[Sort /@ faces], {face_, 1} :> face];
Graphics3D[
{EdgeForm[{Thin, Opacity[1/30, Black]}], Polygon@polys},
AxesLabel -> {"x", "y", "z"},
Axes -> True,
Boxed -> False,
BoxRatios -> {1, 1, 1},
ViewPoint -> 1000 {-1, 1, -1}
]

• Why re-compute the radius of the circum-sphere when you can get it directly from Circumsphere as follows: Circumsphere[p][[2]] – RunnyKine Jul 9 '15 at 5:45
• @RunnyKine Thanks! Didn't notice that before. – Taiki Jul 9 '15 at 10:25
Show[ConvexHullMesh[data],
BoxRatios -> {1, 1, 1},
Axes -> True,
ImageSize -> 500]