How to find points along the inner and outer edge of a ring along a specific direction

Question

I have a set of random numbers distributed on a annular disk. I want to find points on the inner and outer edge along a particular angle.

One possibility is to use ConvexHull. For example

n = 1000;
pts = {#[[1]] Cos[#[[2]]], #[[1]] Sin[#[[2]]]} & /@ 
       Transpose[{RandomReal[{4, 6}, n], RandomReal[{0, 2 Pi}, n]}];

q = -3 Pi/4; (*Direction*)
dq = Pi/10;  (*Span*)

Needs["ComputationalGeometry`"]

dq0=0.01; (*use slightly bigger angle to select*)

pts4=Select[pts, q-dq-dq0 < ArcTan@@# < q+dq+dq0 &];
out=pts4[[ConvexHull[pts4]]];

R=Mean[Norm/@pts4];

edge1=Select[out, q-dq < ArcTan@@# < q+dq && Norm[#] < R &];

edge2=Select[out, q-dq < ArcTan@@# < q+dq && Norm[#] > R &];

Grid[{{
Graphics[{LightBlue,Disk[{0,0},6,{q-dq,q+dq}],
 PointSize[Large],Orange, Point[pts4], PointSize[Small], Black,
 Point[pts], Dashed, Red, Circle[{0,0},4], Circle[{0,0},6]},
 ImageSize->300],
Graphics[{LightBlue,Disk[{0,0},6,{q-dq,q+dq}],
 PointSize[Large], Green, Point[edge1], Blue, Point[edge2], 
 PointSize[Small], Black, Point[pts], Dashed,
 Red, Circle[{0,0},4], Circle[{0,0},6]},
 ImageSize->300]
}}]

But it doesn't cover all edge points.

Another way

Another possibility is, as suggested by Batracos, is to use the radial distance as filtering condition. Since the points are not uniformly distributed, there may or may not be a point within a radial range along a particular direction. As you can see from the figure that the inner edge is much deeper in the middle of the blue region than the border.

Clarification : "Point at the edge"

By point at the edge I mean the points which construct the boundary. For example consider this segment

I need to find points constructing the blue and red lines. ConvexHull gives only points on the green line, which is very small in number. I would prefer a tunable parameter which can determine the roughness of the edges (which is the slice width here). Increasing the roughness/slice width will include more points in this case.

Here I used the the slicing to find the edges

dat = {RandomReal[{-10, 10}], RandomReal[{-2, 2}]} & /@ Range[500];

Needs["ComputationalGeometry`"]
pts1 = dat[[ConvexHull[dat]]];

dqq = 0.5;(*slice width*)
slice = Most@Range[-10, 10, dqq];
edge1 = edge2 = {};
Do[ps = Sort[
  Select[dat, qq < #[[1]] < qq + dqq &], #1[[2]] < #2[[2]] &];
  If[Length[ps] > 0, AppendTo[edge1, First[ps]];
  AppendTo[edge2, Last[ps]];]
,{qq, slice}]

Graphics[{PointSize[Large], Blue, Line[edge1], Red, Line[edge2], 
 Green, Dashed, Line[pts1], PointSize[Small], Black, Point[dat]},
ImageSize -> 300]

Answer 1

I'm not sure which points you really want, so this is a stab in the dark: You could "walk around" the inner resp. outer circle, and pick the closest point in pts to every point on each circle.

(code for the animation at the bottom of the answer.)

Mathematica's Nearest function makes this relatively quick:

n = 1000;
pts = {#[[1]] Cos[#[[2]]], #[[1]] Sin[#[[2]]]} & /@ 
   Transpose[{RandomReal[{4, 6}, n], RandomReal[{0, 2 Pi}, n]}];

nf = Nearest[pts -> Automatic];
{rMin, rMax} = MinMax[Norm /@ pts];
ptsOnCircle = Array[{Cos[#], Sin[#]} &, 1000, {0., 360 °}];

Now nf[{x,y}] returns the index of the closest point to {x,y}, rMin and rMax are the radii of the innermost/outermost points and ptsOnCircle are points on a unit circle.

This function then finds the closest point in pts for each point on a circle, deletes duplicates and creates a "closed" list (i.e. the end point is the start point again):

ptIndices[r_] := Module[{indices = (nf /@ (r*ptsOnCircle))[[All, 1]]},
  indices = DeleteDuplicates[indices];
  Append[indices, First[indices]]]    

Now e.g. pts[[ptIndices[rMin]]] gives the closest points to every point on a circle with radius rMin

Graphics[
 {
  Point[pts],
  Blue, {Thick, Line[pts[[ptIndices[rMin]]]]}, {Dashed, Opacity[0.6], 
   Circle[{0, 0}, rMin]},
  Red, {Thick, Line[pts[[ptIndices[rMax]]]]}, {Dashed, Opacity[0.6], 
   Circle[{0, 0}, rMax]}
  }, ImageSize -> 600]

To control the "jerkiness" of the lines, you can use a transform the "squashes" the points to a thinner ring:

transformRadius[pt_] := pt/Norm[pt]*(Norm[pt]*.1 + 1)

Graphics[Point[transformRadius /@ pts]]

(since the result of ptIndices is a list of indices, this doesn't move the result points, it just modifies the distances used in the calculation.)

nf = Nearest[transformRadius /@ pts -> Automatic];
{rMin, rMax} = MinMax[Norm /@ transformRadius /@ pts];
ptsOnCircle = Array[{Cos[#], Sin[#]} &, 1000, {0., 360 °}];
ptIndices[r_] := Module[{indices = (nf /@ (r*ptsOnCircle))[[All, 1]]},
  indices = DeleteDuplicates[indices];
  Append[indices, First[indices]]]

Graphics[
 {
  Point[pts],
  Blue, {Thick, Line[pts[[ptIndices[rMin]]]]},
  Red, {Thick, Line[pts[[ptIndices[rMax]]]]}
  }, ImageSize -> 600]

Since the points were "squashed" closer together for the calculation, the resulting border line is "jerkier":

---

Here's the code for the animation at the beginning:

Monitor[frames = Table[Graphics[
     {
      {AbsolutePointSize[1/300], Gray, Point[pts]},
      MapThread[
       Function[{r, col},
        Module[{nearest, poly},
         nearest = nf[ptsOnCircle[[i]]*r][[1]];
         poly = 
          Append[TakeWhile[ptIndices[r], # != nearest &], nearest];
         {              
          col, {Line[pts[[poly]]]}, {Dashed, Opacity[0.6], 
           Circle[{0, 0}, r]},
          {Thick, Line[{ptsOnCircle[[i]]*r, pts[[nearest]]}]}
          }]], {{rMin, rMax}, {Red, Blue}}]
      }, ImageSize -> 300], {i, 1, Length[ptsOnCircle], 5}];, i]

ListAnimate[frames]

Answer 2

Your problem is ill-defined, since the notion of a point "along" and edge is not clear (or at least you have not defined it). Setting the convex hull vertices as the points along the outer edge is arbitrary, however, it is a logical approach (from a visual perspective, at least).

Inspired by this approach, I will define the points along the inner edge as the points included in the convex hull over points limited to a radius $r_{min} + r$, where $0<r<r_{max}-r_{min}$, with $r_{min} =4$ and $r_{max}=6$, the inner and outer circle radius, respectively.

In order to select an "appropriate" $r$, I propose the following ad-hoc solution: Find the minimum $r$ such that the area of the corresponding convex hull is at least as large as the inner circle area. Here is a sample of this approach

n = 1000; (*number of points*)
rmin = 4.; 
rmax = 6.;
pts = {#[[1]] Cos[#[[2]]], #[[1]] Sin[#[[2]]]} & /@ 
   Transpose[{RandomReal[{rmin, rmax}, n], RandomReal[{0, 2 Pi}, n]}];
Needs["ComputationalGeometry`"];

pts1 = pts[[ConvexHull[pts]]]; (* points "along" outer edge*)

chullarea[
   r_?NumericQ] :=(*difference of convex hull area (constrained to \
points of radius<rmin+r) with inner circle area*)
  ConvexHullArea[
    Select[pts, (rmin < Norm[#] < rmin + r) &]] - (\[Pi] rmin^2 // N);

r0min = Min[Norm /@ pts] - rmin; (*minimum norm of all points*)
r0 = NMinimize[{r, chullarea[r] > 0 && 2 > r > r0min}, r];
pts2 = Select[
  pts, (Norm[#] < rmin + r0[[1]]) &]; (* points "along" inner edge*)

Graphics[{
  {Green, PointSize[Large], Point[pts1]},
  {Blue, PointSize[Large], Point[pts2]},
  {Dashed, Red, Circle[{0, 0}, rmin]},
  {Dashed, Red, Circle[{0, 0}, rmax]},
  {Point[pts]}
  }
 ]

Answer 3

The random points on the Annulus can be generated and plotted as follows:

SeedRandom[1];
a1 = Annulus[{0, 0}, {4, 6}];
pts = RandomPoint[a1, 1000];
Graphics[{Point@pts
  , {FaceForm[None], EdgeForm[Darker@Green]
   , a1}
  }, Frame -> True]

Using the free cloud account since I have to use ConcaveHullMesh introduced in v13:

cohm=ConcaveHullMesh[pts];
Show[cohm, Graphics[{Red, MeshPrimitives[BoundaryDiscretizeRegion[cohm],1]}]]

To separate the inner and outer red lines, that are not available as separate sets, further processing must be done.

lines=MeshPrimitives[BoundaryDiscretizeRegion[cohm],1]
mp = Det@(Midpoint @@@ lines // Partition[#, 2, 1] & // 
      Flatten[#, {1}] & // Map[Apply[EuclideanDistance]] // 
    Position[#, Max[#]] &)

Graphics[{
  {Red, lines[[1 ;; mp]]}
  , {Blue, lines[[mp + 1 ;;]]}
  , Black, AbsolutePointSize[2]
  , Point@pts
  , {FaceForm[None], EdgeForm[Darker@Green]
   , a1}
  }
 ]

Looking at the flattened out image of points in the OP, this was my best interpretation of the task.

Answer 4

A brute fore way can be to divide the selected region in smaller slices and then choose the terminal points along the radius.

n = 1000;
pts = {#[[1]] Cos[#[[2]]], #[[1]] Sin[#[[2]]]} & /@ 
  Transpose[{RandomReal[{4, 6}, n], RandomReal[{0, 2 Pi}, n]}];

q = -3 Pi/4;(*Direction*)
dq = Pi/10;(*Span*)
pts4 = Select[pts, q - dq - dq0 < ArcTan @@ # < q + dq + dq0 &];


dqq = 0.05; (*angular slice width*)
slice = Most@Range[q - dq, q + dq, dqq];
edge1 = edge2 = {};
Do[
 ps = Sort[Select[pts4, qq < ArcTan @@ # < qq + dqq &], Norm[#1] < Norm[#2] &];
 If[Length[ps] > 0,
   AppendTo[edge1, First[ps]];
   AppendTo[edge2, Last[ps]];
   ]
,{qq, slice}]

Graphics[{LightBlue, Disk[{0, 0}, 6, {q - dq, q + dq}], 
 PointSize[Large], Green, Point[edge1], Blue, Point[edge2], 
 PointSize[Small], Black, Point[pts], Line[edge1], Line[edge2], 
 Dashed, Red, Circle[{0, 0}, 4], Circle[{0, 0}, 6]}, 
ImageSize -> 300]