Faster way to pick pairs of integer coordinates from a "region"
[Update 2: Used Nearest
to compute final points pts
. Another significant speed up.]
The OP's "distance" seems a bit odd and does not obey the triangle inequality. It leads to some odd points. But maybe that's what is being explored. For r1 = 220, r2 = 130
it takes 27 sec. 9 sec. 2.2 sec. Some of the black (x1,y1) points have no neighbor closer than Sqrt[2]
which leads to occasional holes in the red (x2,y2) points.
A not very interesting brute-force method. [Update: I was working out a faster way, and during that time Henrik Schumacher also had the idea of using DiskMatrix
. Multiplying the sparse arrays is slightly faster than subtracting the arrays. It's much faster than my original.]
[Update 3: In response to a comment asking for the pairs, I included two Association
structures, p1$p2
to map {x1, y1}
to the associated points {x2, y2}
, and the inverse relation p2$p1
.]
points2[{r1_, r2_}, c_] :=
ArrayPad[(SparseArray@DiskMatrix[r2] *
(SparseArray[1 - DiskMatrix[r1 - 1, 2 r2 + 1]])) // Transpose,
Transpose@{c - r2 - 1, 512 - c - r2}]["NonzeroPositions"];
Module[{r1 = 20, r2 = 10, c = {100, 100}, nf, p2$for$p1},
pts1 = points2[{r1, r1}, c];
pts2 = points2[{r1 + 1, r1 + r2}, c];
nf = Nearest[pts1];
p2$for$p1 = MapThread[ (* gets the points {x2, y2} for each point {x1, y1} *)
Complement, {nf[pts2, {All, r2 + 1/2}], nf[pts2, {All, r2 - 1/2}]}];
pts = Pick[pts2, Length /@ p2$for$p1 // Unitize, 1]; (* red points below *)
p2$p1 = AssociationThread[pts2 -> p2$for$p1]; (* {x2, y2} -> {x1, y1} *)
p1$p2 = Merge[Join]@ KeyValueMap[ (* {x1, y1} -> {x2, y2} *)
Function[{p2, p1}, AssociationThread[p1, \[FormalP]] /. \[FormalP] -> p2],
p2$p1];
]; // AbsoluteTiming
(* {0.030094, Null} -- was {0.007771, Null} for just pts *)
Graphics[With[{r1 = 20, r2 = 10},
{
Circle[{100, 100}, r1 - 1/2], Circle[{100, 100}, r1 + 1/2],
Point@pts1,
Red, Circle[{100, 100}, r1 + r2 + 1/2],
Point[pts]
}
], GridLines -> {Range@512, Range@512}]
Example use of the associations:
pts2[[138]] (* pick a point {x2, y2} *)
(* {75, 105} *)
mypts2 = {75, 105};
mypts1 = p2$p1[mypts2] (* gets the points {x2, y2} corresponding to {75, 105} *)
Round[Norm[# - {100, 100}]] & /@ mypts (* check distance *)
(*
{{80, 96}, {83, 111}}
{20, 20}
*)
p1$p2[First@mypts] (* gets points {x2, y2} associated to {80, 96} *)
(*
{{70, 95}, {70, 96}, {70, 97}, {70, 98}, {70, 99}, {71, 91}, {71, 92}, {71, 100},
{71, 101}, {72, 90}, {72, 102}, {73, 89}, {73, 103}, {74, 88}, {74, 104}, {75, 87},
{75, 105}, {76, 87}, {76, 105}, {77, 86}, {77, 106}, {78, 86}, {78, 106}, {79, 86},
{79, 106}, {80, 86}, {80, 106}, {81, 86}, {82, 86}, {83, 86}, {84, 87}}
*)
Norm[N[First@mypts - #]] & /@ p1$p2[First@mypts] // Round (* check distances *)
(*
{10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10}
*)
Maybe DiskMatrix
is of interest for you. This is not a complete answer, but I try to show how you might apply DiskMatrix
to your problem. For example, the set of all points {x1,y1}
as specified above can be obtained with the following function:
digitalCirclePoints[xc_, yc_, a_, b_, r_] :=
Module[{xlist, ylist, ipos, pat},
{xlist, ylist} = Transpose[SparseArray[
Subtract[
DiskMatrix[r, {2 r + 1, 2 r + 1}],
DiskMatrix[r - 1, {2 r + 1, 2 r + 1}]
]]["NonzeroPositions"]
];
xlist = Clip[xlist + xc - (r + 1), {1, a}, {0, 0}];
ylist = Clip[ylist + yc - (r + 1), {1, b}, {0, 0}];
ipos = Flatten[Position[Positive[xlist ylist], True, 1]];
pat = Transpose[{xlist[[ipos]], ylist[[ipos]]}]
]
Here are some usage examples:
SeedRandom[1234];
a = 64;
b = 48;
g = GraphicsGrid@Table[
xc = RandomInteger[{1, a}];
yc = RandomInteger[{1, b}];
r1 = RandomInteger[{1, Mean[{a, b}]}];
ArrayPlot[
Transpose@
SparseArray[digitalCirclePoints[xc, yc, a, b, r1] -> 1, {a, b}]],
{3}, {3}]
Analogously, you can find the points {x2,y2}
belonging to each {x1,y1}
in a similar way.