4
$\begingroup$

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]
}}]

enter image description here

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

enter image description here

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]
$\endgroup$
2
  • $\begingroup$ Why not distances = Norm /@ pts; mindistance = Min[distances]; d = .001; in = Pick[pts, Abs[Norm[#] - mindistance] <= d & /@ distances] ? $\endgroup$
    – Batracos
    Commented Aug 2, 2015 at 9:33
  • $\begingroup$ @Batracos, that is what I have suggested. I choose number of points instead of length scale. If you use the length d, you may or may not have a point, because the inner edge is not at same depth everywhere - just look at the middle and border of the shaded region. Your suggestion will fit nicely for uniform points, but for random case - I am not sure. I am editing the question based on your suggestion. $\endgroup$
    – Sumit
    Commented Aug 2, 2015 at 10:54

4 Answers 4

12
$\begingroup$

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.

enter image description here

(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]

enter image description here

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]]

enter image description here

(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":

enter image description here


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]
$\endgroup$
1
$\begingroup$

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]}
  }
 ]

enter image description here

$\endgroup$
1
$\begingroup$

enter image description here

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}
  }
 ]

enter image description here

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

$\endgroup$
0
$\begingroup$

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]

enter image description here

$\endgroup$
2
  • $\begingroup$ Wouldn't this select (almost) every point if the slices were small enough? I think you need to define what you mean by "points on an edge", before you start programming $\endgroup$ Commented Aug 3, 2015 at 10:02
  • $\begingroup$ Thanks @nikie. You are right, for very small slice width, it would take almost every point. In that case I need to control the roughness of the edge to make sure I only have a descent amount of points (again the word descent is ill defined, but I hope you understand what do I mean). I modified my question. $\endgroup$
    – Sumit
    Commented Aug 3, 2015 at 13:33

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.