Skip to main content

list manipulation - Quickly selecting for points in a set that are within a critical distance of points in another set


Imagine two lists of two-dimensional coordinates:


listA = RandomReal[{0,100},{202,2}];
listB = RandomReal[{0,100},{97,2}];


I'm attempting to quickly generate a new series of lists, outputListA and outputListB consisting of the indices for the set of points in listA and listB, respectively, that are within some Euclidean distance $D$ of a point in a list for which they are not a member (i.e. points in listA that are at most a distance distCut from at least one point in listB and vice versa).


This isn't the right way to do things (it takes $\approx 88$ milliseconds for sizes of listA and listB shown), but it hopefully illustrates what I'm trying to do:


listA = RandomReal[{0, 100}, {202, 2}];
listB = RandomReal[{0, 100}, {97, 2}];

outputList = {};
distCut = 1;

For[x = 1, x <= Length[listA], x++,
For[y = 1, y <= Length[listB], y++,

If[EuclideanDistance[listA[[x]], listB[[y]]] <= distCut,
outputList = Append[outputList, {x, y}];
];
];
];

outputListA = Intersection[outputList[[All, 1]], outputList[[All, 1]]];
outputListB = Intersection[outputList[[All, 2]], outputList[[All, 2]]];

Length[outputListA]

Length[outputListB]

A smarter way to proceed might be to round values in listA and listB to a multiple of distCut, and then check for values in the rounded lists that are equal. However, I can't think of a good way to do this that avoids unnecessary attrition / misses points.


A thought - Can we repeatedly apply Nearest for each point $p_i$ in listA until we find a point that is more than a distance distCut from $p_i$? Is Nearest doing anything more sophisticated than sequentially scanning through all of the points in a comparison list and checking Euclidean distances?


Update - I've specified now that outputListA and outputListB should consist of the indices of the points in listA and listB satisfying the distance cutoff criterion.



Answer



Nearest[]supports the following syntax:



Nearest[data,x,{n,r}] give up to the n nearest elements to x within a radius r




So:


listA = RandomReal[{0, 100}, {202, 2}];
listB = RandomReal[{0, 100}, {97, 2}];
distCut = 1;
f = Nearest[listB];
Timing[s = Union[f[#, {Infinity, distCut}] & /@ listA]]


{0., {{}, {{1.80442, 77.5901}}, {{5.51155, 53.6578}}, {{9.51508, 16.3514}}, {{31.804, 24.5855}}, {{35.4298, 36.839}}, {{65.3657, 85.783}}, {{76.6778, 92.0471}}, {{84.3255, 77.5874}}}}




Manipulate[
(s = Flatten[Union[f[#, {Infinity, distCut}] & /@ listA], 1];
Show[ListPlot[{listA, listB}, PlotStyle -> {Red, Blue}],
ListPlot[s, PlotStyle -> {PointSize[Medium], RGBColor[0, distCut/10, 0]}]]),
{distCut, 1, 10}]

enter image description here


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...