6
$\begingroup$

Consider the following code:

ListPointPlot3D[
 Flatten[#, 1] &@
  Table[{x, y, 1}, {x, 0, 5, 5/60}, {y, Sin[x], Cos[x] + 3, (
    Cos[x] + 3 - Sin[x])/60}], PlotRange -> All]

point plot

If I change ListPointPlot3D to ListPlot3D, I get the following:

connected plot

Apparently, ListPlot3D connects the points not in an expected way.

How to plot the set so that the neighboring points were connected with each other, not the far ones?

$\endgroup$
  • $\begingroup$ You want a plot that looks like this RegionPlot3D[ Sin[x] < y < Cos[x] + 3 && z == 1, {x, 0, 5}, {y, -1, 4}, {z, 0, 2}]? $\endgroup$ – N.J.Evans Sep 27 '16 at 20:18
  • $\begingroup$ assuming this is a toy example, for the real problem do you know the underlying functional form for the region? $\endgroup$ – george2079 Sep 27 '16 at 20:32
  • $\begingroup$ @george2079 in the real problem the points come from other sources, I don't know the region in general. $\endgroup$ – Ruslan Sep 27 '16 at 20:41
  • 1
    $\begingroup$ its actually quite a tough problem to find the non-convex boundary of a set of points. (If they are on a regular grid as in example that helps) $\endgroup$ – george2079 Sep 27 '16 at 20:47
  • $\begingroup$ related mathematica.stackexchange.com/q/124562/2079 $\endgroup$ – george2079 Sep 27 '16 at 23:17
4
$\begingroup$

If the points form a deformed rectangular grid, then you can use the method below; otherwise, the methods of the following question should work:

DelaunayMesh in a specified closed region - creating a concave hull from a set of points

For a tensor grid of points:

pts = N@Table[{x, y, Cos[x] Sin[y]},  (* varying height *)
    {x, 0, 5, 5/60},
    {y, Sin[x], Cos[x] + 3, (Cos[x] + 3 - Sin[x])/60}];

With[{p = Flatten[pts, 1]},
 Graphics3D[
  GraphicsComplex[
   p,
   {EdgeForm[], ColorData[97][2],
    Polygon[
     Flatten[#][[{1, 2, 4, 3}]] & /@ Flatten[Partition[
        Partition[Range@Length@p, Length@First@pts],
        {2, 2}, {1, 1}],
       1]
     ]}
   ]]]

Mathematica graphics

It works even better if the height is a constant 1.

$\endgroup$
4
$\begingroup$

You can restrict your PlotRegion in Plot3D

Plot3D[1,{x,0,5},{y,-1,4},RegionFunction->(Sin[#1]<#2<Cos[#1]+3&)]

enter image description here

For more complicated Regions you should use RegionPlot3D. Here is the restriction for all 3 dimensions (which creates a beautiful figure if you ask me):

RegionPlot3D[(Sin[x]<y<Cos[x]+3)&&(Sin[y]<z<Cos[y]+3)&&(Sin[z]<x<Cos[z]+3),{x,-1,4},{y,-1,4},{z,-1,4},MaxRecursion->10,PlotPoints->100]

enter image description here

$\endgroup$
  • $\begingroup$ you can use the same RegionFunction with ListPlot3D as well $\endgroup$ – george2079 Sep 27 '16 at 20:37
2
$\begingroup$

ListPlot3D accepts RegionFunction, so let's exploit this fact. The idea is to create a region.

data = Flatten[#, 1] &@
  Table[{x, y, 1}, {x, 0, 5, 5/60}, {y, Sin[x], 
    Cos[x] + 3, (Cos[x] + 3 - Sin[x])/60}]

data2D = data[[All, 1 ;; 2]]

range = {{0, 5}, {-1, 4}}

First, Binarize the region

reg = Binarize@
  ListPlot[data2D, Axes -> False, AspectRatio -> 1, 
   PlotStyle -> PointSize -> Large]

so that one can use the functions of bobthechemist and rhermans:

binaryImageToRegion[bimg_] := 
 With[{idata = ImageData[bimg], xmax = First@ImageDimensions[bimg], 
   ymax = Last@ImageDimensions[bimg]}, 
  BoundaryDiscretizeGraphics@
   First@RegionPlot[
     idata[[IntegerPart@(ymax - y), IntegerPart@x]] == 1, {x, 1, 
      xmax}, {y, 1, ymax}]]

reg1 = binaryImageToRegion[ColorNegate@reg]

enter image description here

{100, 100} \[Element] reg1
{200, 200} \[Element] reg1

False

True

and

imgregion[im_] := 
 Polygon[Part[#, Last@FindShortestTour[#]] &@
   PixelValuePositions[
    MorphologicalPerimeter[
     Erosion[FillingTransform@ColorNegate@Binarize[im, 0.91], 2], 
     CornerNeighbors -> False], 1]]

reg2 = BoundaryDiscretizeRegion@imgregion[reg];

plot = RegionPlot@reg2

enter image description here

{100, 100} \[Element] reg2
{200, 200} \[Element] reg2

False

True

I'll use reg1 here; exactly the same results were obtained with reg2.

We need to translate the coordinates in data, which are in the range, so that they correspond to those in reg1. We need to take dimensions of the RegionPlot of reg1, without the Frame:

id = ImageDimensions @ RegionPlot[#, Frame -> None] &@reg1

{360, 360}

I calculated it with pen and paper, but it's easy (the transformation is linear) to do it automatically. With the derived RegionFunction:

ListPlot3D[data, 
 RegionFunction -> 
  Function[{x, y, z}, {72 x, (y + 1) 72} \[Element] reg1]]

enter image description here

$\endgroup$

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.