8
$\begingroup$

I have the following data:

data = {{223., 275.}, {212.5, 271.5}, {97.3889, 270.167}, {40., 269.}, {52.75, 266.875},{104.5, 265.5}, {241.7, 265.5}, {205.318, 263.318}, {217.045, 262.136}, {117.3, 257.5}, {69.2, 253.8}, {106.611, 253.833}, {198.389, 253.833}, {222., 254.}, {233.5, 254.}, {36.3889, 252.833},{210.214, 252.643}, {125.5, 250.5}, {92.5, 246.7}, {136.2, 246.8}, {115., 246.}, {147.682, 245.682}, {21.3, 244.5}, {104.5, 244.5}, {217.3, 244.5}, {244.3, 244.5}, {42.5, 242.3}, {72.8, 242.2}, {193.864, 241.955}, {31.8636, 240.955}, {123.1, 241.1}, {156., 241.}, {52., 240.}, {84.3889, 239.833}, {97.5, 237.5}, {142.786, 237.5}, {237.167, 237.611}, {64.5, 236.3}, {133.5, 236.5}, {109.045, 234.136}, {223.045, 234.136}, {34.4091, 232.864}, {77.3889, 232.833}, {117.318, 232.773}, {87.625, 231.625}, {151.3, 231.5}, {12.9545, 228.136}, {98.7, 228.}, {241.611, 225.833}, {139.5, 225.5}, {23.7, 224.5}, {81.1364, 223.409}, {171.3, 223.5}, {35.3889, 221.167}, {120.625, 221.375}, {158.2, 221.2}, {89.1364, 220.045}, {133.5, 217.5}, {147.7, 216.5}, {237.167, 216.611}, {110.167, 215.611}, {166.375, 215.375}, {177.167, 215.389}, {27.1364, 212.955}, {121.9, 211.9}, {38.8333, 210.611}, {92.5, 210.5}, {131.5, 208.3}, {158.056, 208.167}, {143., 207.3}, {19.0833, 204.75}, {72.5, 204.7}, {30.5, 203.5}, {171.167, 203.611}, {239.5, 203.5}, {252.3, 203.5}, {264.136, 203.591}, {84.7, 202.5}, {228.7, 202.5}, {42.3889, 199.833}, {123., 200.}, {51.6111, 198.833}, {76.3182, 196.682}, {64.5, 196.5}, {104.3, 195.5}, {144.167, 194.25}, {259.389, 194.167}, {34.1364, 191.955}, {235., 192.}, {114.833, 190.389}, {187.864, 190.591}, {56.5, 188.5}, {136.409, 188.318}, {158.3, 188.5}, {10.6111, 187.167}, {106.625, 183.625}, {139.409, 181.5}, {230.3, 182.5}, {47.2273, 181.318}, {90.3182, 181.318}, {59.8, 177.8}, {130., 178.}, {187.7, 178.}, {208.7, 175.5}, {81.1364, 174.409}, {139.5, 173.7}, {197.3, 173.5}, {241.833, 173.389}, {89.1154, 170.885}, {59.8, 167.2}, {175.625, 167.375}, {188., 166.}, {72.6111, 165.167}, {110.167, 165.056}, {159.611, 165.167}, {204., 165.}, {84.5, 161.5}, {143.136, 161.409}, {168.833, 161.389}, {262.7, 161.5}, {15.6111, 159.167}, {121.833, 159.389}, {102., 156.9}, {152.5, 157.}, {133.5, 154.5}, {75.0455, 153.136}, {113.625, 153.375}, {162.833, 153.389}, {85.5909, 152.136}, {241.611, 152.167}, {125.5, 149.7}, {96.3, 148.5}, {35.5, 146.5}, {105.5, 145.3}, {152.389, 145.167}, {197., 144.}, {85.7, 141.5}, {134.5, 141.5}, {162.833, 141.611}, {260.5, 141.5}, {175.833, 140.389}, {69.3889, 138.167}, {28.6429, 136.786}, {97.2, 136.8}, {129.167, 136.}, {39.625, 135.625}, {55.1667, 133.611}, {77.5, 133.5}, {164.3, 133.5}, {138.5, 132.5}, {213.5, 132.3}, {9.5, 131.}, {87.6111, 131.167}, {22.3889, 128.833}, {35.3889, 128.833}, {66.7, 128.5}, {177.136, 128.591}, {131.5, 125.3}, {189.722, 125.167}, {202., 125.}, {77.4091, 124.136}, {106.611, 123.833}, {160.611, 124.167}, {28.5, 122.7}, {142., 123.}, {214.5, 123.}, {226.5, 123.}, {15.5, 120.5}, {87.8333, 120.389}, {171.167, 120.611}, {5., 119.3}, {183., 117.}, {259.389, 117.167}, {73.1667, 115.583}, {98.6818, 115.682}, {131.318, 115.682}, {160.682, 114.682}, {34.1667, 114.611}, {193.7, 114.5}, {79.6667, 112.5}, {106.5, 112.5}, {203.786, 112.5}, {214.5, 112.5}, {13., 111.}, {59.3, 111.9}, {87.8636, 111.045}, {228.611, 111.167}, {69.3, 107.5}, {174.7, 107.5}, {151.3, 106.5}, {97.3889, 104.167}, {9.61111, 103.167}, {81., 103.}, {166.611, 103.167}, {61.2, 101.8}, {143., 102.}, {251.056, 101.833}, {71.5, 98.5}, {175.625, 98.375}, {238.167, 98.3889}, {90.3889, 95.8333}, {155.864, 95.9545}, {198.2, 94.9}, {138.375, 94.625}, {14.1667, 93.6111}, {59.8333, 93.6111}, {79.5, 93.5}, {112.682, 91.3182}, {33.875, 90.125}, {69.3182, 87.6818}, {150., 87.7}, {233.5, 87.5}, {180.5, 86.5}, {94., 85.3}, {190.167, 85.3889}, {242.833, 85.3889}, {19.1154, 82.8846}, {82., 83.}, {160.7, 83.}, {202., 83.}, {226.5, 79.7}, {129., 79.7}, {25.6818, 78.2273}, {39., 78.3}, {75.1364, 77.0455}, {48.1364, 74.9545}, {242.864, 74.9545}, {100.7, 73.5}, {120.5, 73.5}, {233.389, 73.1667}, {31.8333, 70.3889}, {69.2, 70.2}, {117.3, 65.5}, {226.5, 64.3}, {214.5, 62.}, {35.5, 60.7}, {205.3, 58.5}, {122., 57.3}, {180.375, 56.375}, {233.5, 56.3}, {43.5, 53.7}, {134.7, 54.}, {171.136, 53.9545}, {222.864, 53.9545}, {143.833, 49.0556}, {114.611, 47.8333}, {48.3, 45.5}, {81., 45.5}, {176., 45.5}, {40., 44.5}, {138.389, 40.8333}, {56.5, 39.7}, {127.239, 34.3261}, {67.0455, 32.8636}, {160.625, 32.625}, {118.5, 31.3}, {141.7, 31.5}, {55.0455, 29.1364}, {104.389, 28.1667}, {81., 26.7}, {93.7, 26.5}, {150., 26.7}, {110., 21.}};

which looks like:

p1 = ListPlot[data, PlotStyle -> Black, AspectRatio -> 1, Axes -> False]

Enter image description here

Now, I need to draw a circle, let's say, with a radius $50$, centered at each of the above points step by step, and count the number points inside the circle. For example, for one of the above points as a center of the circle, one has:

p2 = Graphics[Circle[{79.66666666666667`, 112.5`}, 50]];
Show[p1, p2]

which looks like:

Enter image description here

I can do the above repeatedly for other points as centers of the circle, and then count the number of points inside the circle at each step. However, this is very tedious and time-consuming.

I have the following two questions:

  1. Is there an easier way to do the above procedure, and not manually do the counting and moving the circle around?

  2. If the answer to the above question is yes, I need also the circle to be remained completely inside the region of the points, that is, the center-points which result in a circle which some parts of it go outside the region, to be excluded (when doing by hand, one can detect these points. For example, one set of these points are those ones at the edges of the picture).

Improve this question
$\endgroup$
3
  • $\begingroup$ Part 2 can be rephrased: Is it possible for this circle to remain inside the convex hull established by the points? $\endgroup$
    – Syed
    Sep 7, 2021 at 11:05
  • $\begingroup$ @Syed Why convex? What if the boundaries are concave? $\endgroup$
    – Szabolcs
    Sep 7, 2021 at 18:58
  • $\begingroup$ That's my best interpretation of "circle to remain completely inside the region...". I think that a convex hull would enclose a concave hull for the same set of points. If it is not true in general then can you please elaborate upon it? $\endgroup$
    – Syed
    Sep 7, 2021 at 19:24

3 Answers 3

Reset to default
9
$\begingroup$

Select subset of data that can be used as center of a disk given your second requirement:

r  = 50;

data2 = Select[RegionDistance[RegionBoundary[ConvexHullMesh[data]]]@# > r &]@data;

Associate with each element of data2 a disk with radius r and the set of points from data that lie within that disk:

assoc = AssociationThread[data2, 
   {Tooltip[Disk[#, r], 
      Grid[{{"disk center:", #}, {"number of points:", Length@{##}}}, 
       Dividers -> All, Alignment -> {Left, Center}]], 
    Point @ {##2}} & @@@ Nearest[data, data2, {All, r}]];

Use LocatorPane to interactively select a disk using the element of data2 closest to the locator:

NF = Nearest[data2];

DynamicModule[{pt = Mean[data]}, 
 LocatorPane[Dynamic[pt], 
  Dynamic @ Graphics[{
      Point @ data, 
      Green, PointSize[Medium], Point @ data2,
      PointSize[Large], Red, Point @ NF @ pt, 
      PointSize[Medium], Blue, EdgeForm[Red], FaceForm[Opacity[.3, Red]], 
        assoc @ First[NF @ pt]}, 
    PlotRange -> (MinMax /@ Transpose[data]), 
    PlotRangePadding -> Scaled[.02]]]]

enter image description here

Improve this answer
$\endgroup$
0
8
$\begingroup$

Use Nearest to retrieve all points from a dataset that are within radius r of a chosen point. First, construct the "nearest function",

nf = Nearest[pts]

Then to get all points within radius r of pt, you can use nf[pt, {All, r}].

Improve this answer
$\endgroup$
1
  • $\begingroup$ @Eternity It is not clear to me where you want to move the circle to (other than that you want to keep it within a certain region). It is also unclear which specific region you want to restrict it to. One comment said convex hull. What if the points are in a highly non-convex region? $\endgroup$
    – Szabolcs
    Sep 7, 2021 at 18:57
2
$\begingroup$

Here is a function to locate points, and bounding regions for the data. A circle at a point in the red area would include parts outside the br bounding region.

r = 50; (* choose a radius *)
nf = Nearest[data];
br = BoundingRegion[data, "MinDisk"];
c = RegionCentroid[br];
br2 = Disk[c, br[[2]] - r];

Show[Region[Style[br, Red]], Region[br2], 
 Epilog -> {Black, Point[data]}]

bounding region

We can find all the center-points which result in circles which remain inside the br region. Let's use one of these points to demonstrate how to find points within a circle with radius r.

testPoints = nf[c, {All, br2[[2]]}];
SeedRandom[123];
pt = RandomChoice[testPoints]; (* one of the testPoints *)
pts = nf[pt, {All, r}];
Show[Region[Style[RegionBoundary[br], Red]], Region[Disk[pt, r]], 
 Epilog -> {Black, Point[pts]}]
Length[pts]

selected points

(* 41 *)

Find points within radius r for all the testPoints:

nf[#, {All, r}] &@ testPoints
Improve this answer
$\endgroup$

Your Answer

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