Quickly pruning elements in one structured array that exist in a separate unordered array

Question

I have two lists, which we'll call testList and modifiedTestList. The first list looks something like this:

testList = Table[RandomReal[{0, 1000}, {RandomInteger[{0, 32}], 2}], {i, 1, 10}];

To generate modifiedTestList, I can flatten testList by strictly one level (never breaking up the pairs of real numbers specifying 2D coordinates), scramble the elements, and select and prune elements. For example:

modifiedTestList = Flatten[testList, 1];
modifiedTestList = RandomSample[modifiedTestList, Length[modifiedTestList]];
modifiedTestList = Select[modifiedTestList, #[[1]] > 700 &];

Once I've had my fun, I'd like to take testList and prune away all of the 2D coordinates that no longer exist in modifiedTestList while respecting the original array structure of testList (i.e. testList should not be flattened and elements should not be moved between subarrays).

Let's say testList and modifiedTestList are both quite large ($>10^6$ elements each). Is there a fast way to do the above pruning provided these large data structures?

Answer 1

This method assumes modifiedTestList is a given.

rules = Dispatch@Thread[Rule[modifiedTestList, Sequence[]]]
tmp1=Replace[testList, rules, {2}]

Also

tmp2=DeleteCases[testList, Alternatives @@ modifiedTestList, {2}]

I've limited these to looking at level 2 so as to eliminate any unneeded level snooping. I'm sure others will have some alternatives but best to try on your real world example and report back the timings.

tmp1==tmp2
(*  True *)

Edit

I may have misread. In the above I've deleted the elements of modifiedTestList from testList. If you want the opposite then

tmp3=DeleteCases[testList, Except[Alternatives @@ modifiedTestList], {2}]

or

rules2 = Dispatch@Thread[Rule[Complement[Flatten[testList, 1], modifiedTestList], 
    Sequence[]]]
tmp4 = Replace[testList, rules2, {2}]

tmp3==tmp4
(*  True  *)

Answer 2

Here are fresh-kernel times (on a slower machine) for tmp4, tmp5, and three more methods. tmp6 is just tmp5 using Scan instead of Do. tmp7 and tmp8 get the Intersection of the modified list with each original sublist; the results are sorted within sublists. tmp8 saves time by reducing the modified list from one comparison to the next.

In[1]:= Length /@ (A = Table[RandomReal[{0, 1000}, {RandomInteger[{1*^4, 5*^4}], 2}], {10}])
Out[1]= {42008, 46556, 23970, 45599, 12340, 32636, 45232, 39218, 24238, 14579}

In[2]:= Length[B = RandomSample@Select[Join @@ A, #[[1]] > 700 &]]
Out[2]= 97983

In[3]:= First@AbsoluteTiming[
        rules2 = Dispatch@Thread[Rule[Complement[Flatten[A, 1], B], Sequence[]]];
        tmp4 = Replace[A, rules2, {2}];]
Out[3]= 6.239390

In[4]:= First@AbsoluteTiming[tmp5 = Block[{f}, Do[f[p] = p, {p, B}];
        f[_] := Sequence[]; Map[f, A, {2}]];]
Out[4]= 6.078836

In[5]:= First@AbsoluteTiming[tmp6 = Block[{f}, Scan[(f@# = #)&, B];
        f[_] := Sequence[]; Map[f, A, {2}]];]
Out[5]= 4.580439

In[6]:= SameQ[tmp4, tmp5, tmp6]
Out[6]= True

In[7]:= First@AbsoluteTiming[tmp7 = Intersection[#, B]& /@ A;]
Out[7]= 2.802139

In[8]:= First@AbsoluteTiming[tmp8 = Block[{b = B}, Join[
        ((b = Complement[b, #]; #)& @ Intersection[#, b])& /@ Most@A, {b}] ]]
Out[8]= 1.288282

In[9]:= SameQ[Sort/@tmp6, tmp7, tmp8]
Out[9]= True