Provided an array of 2D point clouds, can we quickly replace distance- and index-based cliques of points with their median or mean values?

Question

Imagine I have $N \approx 10^5$ clouds of points in an array of the form:

UPDATED

numClouds = 10^3;
cloudList = Table[Table[{RandomInteger[{0, 2}] + RandomReal[{-0.1, 0.1}], RandomInteger[{0, 2}] + RandomReal[{-0.1, 0.1}]}, {j, 1, RandomInteger[{0, 50}]}], {i, 1, numClouds}];

Notice that we generate points here by first randomly snapping them to a coordinate in an integer lattice, and then adding some real number valued noise:

ListPlot[Flatten[cloudList,1]]

I'd like to move a sliding window over cloudList of size $k$ (e.g. $k = 10$) where we take all of the points in {cloudList[[i]], cloudList[[i+1]], ..., cloudList[[i+k]]}, establish cliques for points within a Euclidean distance $d$ of one-another (i.e. if we can place a circle of diameter $d$ over a set of points, it's a clique), and then replace all of the points within each clique with the median or mean point value of the given clique. I would like to do this without disturbing the array structure of cloudList.

In terms of finding a fast way to grab all the points within a critical radius of $\frac{d}{2}$, we can use a poorly documented version of Nearest:

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

The above was from an answer by the user "ssch" (https://mathematica.stackexchange.com/users/1517/ssch) to my question: Selecting for 2D points that are within a threshold distance of an upper- and lower-bound number of points

---

Update - I neglected to specify what should occur when points can belong to more than one clique. The user belisarius (https://mathematica.stackexchange.com/users/193/belisarius), for example, asked about the cliques for a point set Tuples[{1, 0}, 2] where r = 3/2. Here, all four points belong to the same clique:

list = Tuples[{1, 0}, 2];
nf = Nearest[list];
nf[list[[1]], {Infinity, N[3/2]}]

out :: {{1, 1}, {1, 0}, {0, 1}, {0, 0}}

So we'd set each point in this clique to {1/2,1/2}.

However, if we set r = 1, we have Binomial[4, 3] = 4 seperate cliques with overlapping points:

{{1, 1}, {1, 0}, {0, 1}}
{{1, 0}, {1, 1}, {0, 0}}
{{0, 1}, {1, 1}, {0, 0}}
{{0, 0}, {1, 0}, {0, 1}}

To resolve this, I'd like to generate each clique as above, compute a mean for each clique, and where points fall in multiple cliques, to randomly assign these points the mean or median value selected with uniform probability from each clique. However, I'd be open to simpler solutions that are easier to implement.

---

(2nd) Update - I have changed the method of generating the random test set s.t. we now first snap a randomly generated test point to a bounded integer lattice coordinate, then add noise.

---

(3rd) Update - This is more of a note, but I would be fine employing a simple greedy algorithm to partition points into clusters, or using FindClusters with a EuclideanDistance distance function (this is slightly less comfortable since I'm not exactly sure what the underlying algorithm is).

Answer 1

An alternative to using a clustering method would be to try one of the nonlinear filters. In this case, the MeanShiftFilter might be useful:

ListPlot[MeanShiftFilter[Flatten[cloudList, 1], 500, 0.5]]

This uses a sliding window approach and finds all the points in the neighborhood and then averages only those within the 0.5 radius. While this doesn't give you exact values, presumably you could quantize the resulting small blobs without too much trouble. You can get qualitatively the same results using the BilateralFilter as well:

BilateralFilter[Flatten[cloudList, 1], 200, 0.2]

Answer 2

The natural choice is FindClusters[], and it will work quite well in these kind of situations, provided you are willing to experiment a little with its options:

s = FindClusters[Flatten[cloudList, 1], 
                DistanceFunction -> ((E^(SquaredEuclideanDistance[#1, #2]) - 1) &), 
                Method -> {"Agglomerate", "Linkage" -> "Complete"}]; 
ListPlot[s,  PlotMarkers -> Automatic]

ListPlot[Mean /@ s, PlotStyle -> PointSize@Large]