Unsorted custom intersection

I have two lists of complex numbers, list1 and list2, sorted by decreasing imaginary part. list2 is strictly longer than list1.

Most numbers of list1 will be different than those in list2, but some will be close.

I want to find the intersection of these lists, where two complex numbers are considered equal if they differ in absolute value by at most 10^-n.

The built-in way to do this would be

intersection = Intersection[list1,list2,SameTest->(Abs[#1-#2]<10^-4&)];


However the intersection I want is different from this:

• The order should stay fixed
• Duplicates within one list should not be removed
• By default the intersection should be taken from list1, with the option of also giving a second list which is the intersection with elements taken from list2.
• This second intersection should differ from the first only in the order 10^-n differences in the elements, not in length or ordering.

A simple but slow way of doing this would be:

intersection1 = Select[list1,Min@Abs[#-list2]<10^-4&];
intersection2 = Function[el1,MinimalBy[list2,Abs[#-el1]&][[1]]]/@intersection1;


Note that if we did the intersection2 the same way as intersection1, it would likely contain more elements, as list2 is longer than list1, so list2 may contain several points close to one point in intersection1.

There must be a more elegant and quick way though, at the very least this is doing the work twice.

Typical list lengths are from 100 to 1000 elements, around 10.000 at the very max, so speed is important but not critical, I'm mostly just curious how to do this properly in Mathematica.

You could use Nearest for determining intersection1. Here is some sample data:

SeedRandom[3];
list1=RandomComplex[1+I, 10^3];
list2=RandomComplex[1+I, 10^4];


Create the Nearest function:

nf = Nearest[list1 -> {"Element", "Distance"}]; //AbsoluteTiming


{0.000092, Null}

Apply the nearest function to the second list, and select the elements that are close:

Cases[nf[list2], {{p_, d_}} /; d < 10^-4 :> p] //AbsoluteTiming


{0.047424, {0.68503 + 0.864287 I}}

intersection1 = Select[list1, Min@Abs[#-list2]<10^-4&] //AbsoluteTiming