4
$\begingroup$

I have the following data set

regionpt={{1.98549, -9.63663, 0.000175534}, {1.98549, 9.63663, 0.000175534},
{1.88018, -8.53927, 0.0000752711}, {1.88018, 8.53927, 0.0000752711}, 
{1.76991, -7.52454, 0.000259522}, {1.76991, 7.52454, 0.000259522}, 
{1.65418, -6.59002, 0.000428226}, {1.65418, 6.59002, 0.000428226}, 
{1.53246, -5.7332, 0.000239152}, {1.53246, 5.7332, 0.000239152}, 
{1.40408, -4.9514, 0.000916734}, {1.40408, 4.9514, 0.000916734}, 
{1.26824, -4.24183, 0.00135667}, {1.26824, 4.24183, 0.00135667}, 
{1.12393, -3.60157, 0.00115797}, {1.12393, 3.60157, 0.00115797}, 
{0.969869, -3.02756, 0.00179841}, {0.969869, 3.02756, 0.00179841}, 
{0.804309, -2.51667, 0.00323765}, {0.804309, 2.51667, 0.00323765}, 
{0.624759, -2.06561, 0.0039468}, {0.624759, 2.06561, 0.0039468}, 
{0.427375, -1.67104, 0.00303385}, {0.427375, 1.67104, 0.00303385}, 
{0.205564, -1.32947, 0.00235364}, {0.205564, 1.32947, 0.00235364}, 
{-0.0537818, -1.03737, 0.0256703}, {-0.0537818, 1.03737, 0.0256703}, 
{-0.383654, -0.791088, 0.123001}, {-0.383654, 0.791088, 0.123001}, 
{-0.922168, -0.586907, 0.259956}, {-0.922168, 0.586907, 0.259956}}

This data set is extracted from a larger set of which it constitutes the boundary region, that is the region for which the coordinate y gets its minimum and maximum values.

The boundary of this surface is concave, so when I ask Mathematica to ListPlot3D the data above I get the following result

ListPlot3D[regionpt, PlotRange -> All]

ListPlot3D[regionpt, PlotRange -> All]

Is there a way to have Mathematica remove the artificially added "wings"?

$\endgroup$
  • 1
    $\begingroup$ Possible duplicate: (36766) $\endgroup$ – ybeltukov Jan 29 '15 at 12:54
  • $\begingroup$ I had looked at this before submitting my question and was not able to apply the solution suggested there to the case I am reporting $\endgroup$ – Daniele Binosi Jan 30 '15 at 10:57
6
$\begingroup$

We can create a MeshRegion of your region in this case and an interpolation ifn that can be used in Plot3D:

reg = MeshRegion[regionpt[[All, 1 ;; 2]], Polygon@FindCurvePath[regionpt]];
ifn = Interpolation[regionpt, InterpolationOrder -> 1];

Show[
 Plot3D[ifn[x, y], {x, y} ∈ reg, PlotRange -> All],
 Graphics3D[{Red, PointSize[Medium], Point[regionpt]}]
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Very elegant solution. Thank you very much for the answer! $\endgroup$ – Daniele Binosi Jan 30 '15 at 16:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.