4 replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
source | link

This question follows my initial question that can be found herehere.

This question follows my initial question that can be found here.

This question follows my initial question that can be found here.

3 deleted 115 characters in body
source | link
coo1 = data.txt
maxvalue = Max[coo1[[All, 4]]]*1000;
minvalue  = Min[coo1[[All, 4]]]*1000;
coo2 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , {
    AppendTo[coo2, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo2 = Delete[coo2, 1];
coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &];
coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &];
coo3 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, {
    AppendTo[coo3, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo3 = Delete[coo3, 1];
coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &];
coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &];
coo6 =  Select[coo1, #[[4]] > 0.0082 & ];
coo7 = Select[coo6, #[[4]] < 0.0085 & ];
coo8 = Select[coo7, #[[1]]  < 0.25  &];
coo9 = Select[coo8, #[[2]]  < 0.25  &];
coo10 = Select[coo7, #[[1]]  < 0.25  &];
coo11 = Select[coo10, #[[2]]  > 0.25  &];
coo12 = Select[coo7, #[[1]]  > 0.5 &];
coo13 = Select[coo12, #[[2]]  < 1.0  &];
coo14 = Select[coo7, #[[1]]  > 0.5 &];
coo15 = Select[coo14, #[[2]]  > 1.0  &];

alphaShapes2D[points_, crit_] := 
  Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, 
    tetcoords, tetradii, selectExternalFaces}, 
   alphacriteria[tetrahedra_, radii_, rmax_] := 
    Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1];
   selectExternalFaces[facets_] := MeshRegion[points, facets];
   If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2];
    tetcoords = MeshPrimitives[del, 2][[All, 1]];
    tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]];
    selectExternalFaces@alphacriteria[tetras, tetradii, crit]]];

reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2]
nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]];
colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@"TemperatureMap"]@
    First@nf[{#1, #2, #3}] &;
p1 = ListPlot3D[coo21[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2]
nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p11 = ListPlot3D[coo22[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2]
nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p2 = ListPlot3D[coo4[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, 
  PlotLegends -> 
   BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, 
    ColorFunctionScaling -> True]]
reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15]
nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p3 = ListPlot3D[coo5[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]

nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]];
colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@ColorData["TemperatureMap"]@
    First@nf[{#1, #2, #3}] &;
p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]
coo1 = data.txt
maxvalue = Max[coo1[[All, 4]]]*1000;
minvalue  = Min[coo1[[All, 4]]]*1000;
coo2 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , {
    AppendTo[coo2, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo2 = Delete[coo2, 1];
coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &];
coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &];
coo3 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, {
    AppendTo[coo3, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo3 = Delete[coo3, 1];
coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &];
coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &];
coo6 =  Select[coo1, #[[4]] > 0.0082 & ];
coo7 = Select[coo6, #[[4]] < 0.0085 & ];
coo8 = Select[coo7, #[[1]]  < 0.25  &];
coo9 = Select[coo8, #[[2]]  < 0.25  &];
coo10 = Select[coo7, #[[1]]  < 0.25  &];
coo11 = Select[coo10, #[[2]]  > 0.25  &];
coo12 = Select[coo7, #[[1]]  > 0.5 &];
coo13 = Select[coo12, #[[2]]  < 1.0  &];
coo14 = Select[coo7, #[[1]]  > 0.5 &];
coo15 = Select[coo14, #[[2]]  > 1.0  &];

alphaShapes2D[points_, crit_] := 
  Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, 
    tetcoords, tetradii, selectExternalFaces}, 
   alphacriteria[tetrahedra_, radii_, rmax_] := 
    Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1];
   selectExternalFaces[facets_] := MeshRegion[points, facets];
   If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2];
    tetcoords = MeshPrimitives[del, 2][[All, 1]];
    tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]];
    selectExternalFaces@alphacriteria[tetras, tetradii, crit]]];

reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2]
nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]];
colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@
    First@nf[{#1, #2, #3}] &;
p1 = ListPlot3D[coo21[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2]
nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &;
p11 = ListPlot3D[coo22[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2]
nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p2 = ListPlot3D[coo4[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, 
  PlotLegends -> 
   BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, 
    ColorFunctionScaling -> True]]
reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15]
nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &;
p3 = ListPlot3D[coo5[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]

nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]];
colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@
    First@nf[{#1, #2, #3}] &;
p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]
coo1 = data.txt
maxvalue = Max[coo1[[All, 4]]]*1000;
minvalue  = Min[coo1[[All, 4]]]*1000;
coo2 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , {
    AppendTo[coo2, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo2 = Delete[coo2, 1];
coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &];
coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &];
coo3 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, {
    AppendTo[coo3, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo3 = Delete[coo3, 1];
coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &];
coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &];
coo6 =  Select[coo1, #[[4]] > 0.0082 & ];
coo7 = Select[coo6, #[[4]] < 0.0085 & ];
coo8 = Select[coo7, #[[1]]  < 0.25  &];
coo9 = Select[coo8, #[[2]]  < 0.25  &];
coo10 = Select[coo7, #[[1]]  < 0.25  &];
coo11 = Select[coo10, #[[2]]  > 0.25  &];
coo12 = Select[coo7, #[[1]]  > 0.5 &];
coo13 = Select[coo12, #[[2]]  < 1.0  &];
coo14 = Select[coo7, #[[1]]  > 0.5 &];
coo15 = Select[coo14, #[[2]]  > 1.0  &];

alphaShapes2D[points_, crit_] := 
  Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, 
    tetcoords, tetradii, selectExternalFaces}, 
   alphacriteria[tetrahedra_, radii_, rmax_] := 
    Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1];
   selectExternalFaces[facets_] := MeshRegion[points, facets];
   If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2];
    tetcoords = MeshPrimitives[del, 2][[All, 1]];
    tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]];
    selectExternalFaces@alphacriteria[tetras, tetradii, crit]]];

reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2]
nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]];
colfun = ColorData[{"TemperatureMap"]@
    First@nf[{#1, #2, #3}] &;
p1 = ListPlot3D[coo21[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2]
nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p11 = ListPlot3D[coo22[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2]
nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p2 = ListPlot3D[coo4[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, 
    ColorFunctionScaling -> True]]
reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15]
nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p3 = ListPlot3D[coo5[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]

nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@
    First@nf[{#1, #2, #3}] &;
p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]
2 added 4924 characters in body
source | link

Edit

The code used to split the data and produce the full picture is the following. I was not so keen as to share it as I'm sure its very ugly, inefficient and long. Bear in mind that I started using Mathematica 3 days ago... I'm very happy to improve though.

coo1 = data.txt
maxvalue = Max[coo1[[All, 4]]]*1000;
minvalue  = Min[coo1[[All, 4]]]*1000;
coo2 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , {
    AppendTo[coo2, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo2 = Delete[coo2, 1];
coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &];
coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &];
coo3 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, {
    AppendTo[coo3, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo3 = Delete[coo3, 1];
coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &];
coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &];
coo6 =  Select[coo1, #[[4]] > 0.0082 & ];
coo7 = Select[coo6, #[[4]] < 0.0085 & ];
coo8 = Select[coo7, #[[1]]  < 0.25  &];
coo9 = Select[coo8, #[[2]]  < 0.25  &];
coo10 = Select[coo7, #[[1]]  < 0.25  &];
coo11 = Select[coo10, #[[2]]  > 0.25  &];
coo12 = Select[coo7, #[[1]]  > 0.5 &];
coo13 = Select[coo12, #[[2]]  < 1.0  &];
coo14 = Select[coo7, #[[1]]  > 0.5 &];
coo15 = Select[coo14, #[[2]]  > 1.0  &];

alphaShapes2D[points_, crit_] := 
  Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, 
    tetcoords, tetradii, selectExternalFaces}, 
   alphacriteria[tetrahedra_, radii_, rmax_] := 
    Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1];
   selectExternalFaces[facets_] := MeshRegion[points, facets];
   If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2];
    tetcoords = MeshPrimitives[del, 2][[All, 1]];
    tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]];
    selectExternalFaces@alphacriteria[tetras, tetradii, crit]]];

reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2]
nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]];
colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@
    First@nf[{#1, #2, #3}] &;
p1 = ListPlot3D[coo21[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2]
nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &;
p11 = ListPlot3D[coo22[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2]
nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p2 = ListPlot3D[coo4[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, 
  PlotLegends -> 
   BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, 
    ColorFunctionScaling -> True]]
reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15]
nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &;
p3 = ListPlot3D[coo5[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]

nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]];
colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@
    First@nf[{#1, #2, #3}] &;
p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]

Edit

The code used to split the data and produce the full picture is the following. I was not so keen as to share it as I'm sure its very ugly, inefficient and long. Bear in mind that I started using Mathematica 3 days ago... I'm very happy to improve though.

coo1 = data.txt
maxvalue = Max[coo1[[All, 4]]]*1000;
minvalue  = Min[coo1[[All, 4]]]*1000;
coo2 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , {
    AppendTo[coo2, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo2 = Delete[coo2, 1];
coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &];
coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &];
coo3 = {coo1[[1, 1 ;; 4]]};
Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, {
    AppendTo[coo3, coo1[[i, 1 ;; 4]]]
    },], {i, 1, Length[coo1[[All, 1]]]}];
coo3 = Delete[coo3, 1];
coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &];
coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &];
coo6 =  Select[coo1, #[[4]] > 0.0082 & ];
coo7 = Select[coo6, #[[4]] < 0.0085 & ];
coo8 = Select[coo7, #[[1]]  < 0.25  &];
coo9 = Select[coo8, #[[2]]  < 0.25  &];
coo10 = Select[coo7, #[[1]]  < 0.25  &];
coo11 = Select[coo10, #[[2]]  > 0.25  &];
coo12 = Select[coo7, #[[1]]  > 0.5 &];
coo13 = Select[coo12, #[[2]]  < 1.0  &];
coo14 = Select[coo7, #[[1]]  > 0.5 &];
coo15 = Select[coo14, #[[2]]  > 1.0  &];

alphaShapes2D[points_, crit_] := 
  Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, 
    tetcoords, tetradii, selectExternalFaces}, 
   alphacriteria[tetrahedra_, radii_, rmax_] := 
    Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1];
   selectExternalFaces[facets_] := MeshRegion[points, facets];
   If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2];
    tetcoords = MeshPrimitives[del, 2][[All, 1]];
    tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]];
    selectExternalFaces@alphacriteria[tetras, tetradii, crit]]];

reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2]
nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]];
colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@
    First@nf[{#1, #2, #3}] &;
p1 = ListPlot3D[coo21[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2]
nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &;
p11 = ListPlot3D[coo22[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]
reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2]
nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]];
colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &;
p2 = ListPlot3D[coo4[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, 
  PlotLegends -> 
   BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, 
    ColorFunctionScaling -> True]]
reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15]
nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]];
colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &;
p3 = ListPlot3D[coo5[[All, 1 ;; 3]], 
  RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], 
  ColorFunction -> colfun, ColorFunctionScaling -> False, 
  MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10]

nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]];
colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@
    First@nf[{#1, #2, #3}] &;
p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, 
   ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5];
Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]
1
source | link