performance tuning - In a list of points, how to efficiently delete points which are close to other points?

Consider a list of points:

pts = Partition[RandomReal[1, 10000], 2];

ListPlot[pts]

I'd like to delete points so that the minimum distance between two points is 0.05. The following code does the job:

pts2 = {pts[[1]]};
Table[If[Min[Map[Norm[pts[[i]] - #] &, pts2]] > 0.05, 
AppendTo[pts2, pts[[i]]]], {i, 2, Length[pts], 
1}]; // AbsoluteTiming (* -> 1.35 *)
ListPlot[pts2]

But it becomes slow for large lists, probably because of AppendTo which does not know what type is going to come next.

How could this be done more efficiently? Note: there is no uniqueness of the resulting list, but that's not a problem.

Just for better referencing, let me give another formulation of the question: How to delete points in a neighbourhood of other points of a list?

Answer

The following is a much faster, but not optimal, recursive solution:

pts = RandomReal[1, {10000, 2}];
f = Nearest[pts];

k[{}, r_] := r

k[ptsaux_, r_: {}] := Module[{x = RandomChoice[ptsaux]}, 
                      k[Complement[ptsaux, f[x, {Infinity, .05}]],  Append[r, x]]]

ListPlot@k[pts]

---

Some timings show this is two orders of magnitude faster than the OP's method:

ops[pts_] := Module[{pts2},
  pts2 = {pts[[1]]};

  Table[If[Min[Map[Norm[pts[[i]] - #] &, pts2]] > 0.05, 
    AppendTo[pts2, pts[[i]]]], {i, 2, Length[pts], 1}];
  pts2]

bobs[pts_] := Union[pts, SameTest -> (Norm[#1 - #2] < 0.05 &)]

belis[pts_] := Module[{f, k},
  f = Nearest[pts];
  k[{}, r_] := r;
  k[ptsaux_, r_: {}] := Module[{x = RandomChoice[ptsaux]}, 

                        k[Complement[ptsaux, f[x, {Infinity, .05}]], Append[r, x]]];
  k[pts]]


lens = {1000, 3000, 5000, 10000};
pts = RandomReal[1, {#, 2}] & /@ lens;
ls = First /@ {Timing[ops@#;], Timing[bobs@#;], Timing[belis@#;]} & /@  pts;
ListLogLinePlot[  MapThread[List, {ConstantArray[lens, 3], Transpose@ls}, 2], 
               PlotLegends -> {"OP", "BOB", "BELI"}, Joined ->True]