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$
2
  • 1
    $\begingroup$ Possible duplicate: (36766) $\endgroup$
    – ybeltukov
    Commented Jan 29, 2015 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$ Commented Jan 30, 2015 at 10:57

1 Answer 1

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$
1
  • $\begingroup$ Very elegant solution. Thank you very much for the answer! $\endgroup$ Commented Jan 30, 2015 at 16:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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