Re: Identifying clusters of adjacent points on a lattice
- To: mathgroup at smc.vnet.net
- Subject: [mg81406] Re: Identifying clusters of adjacent points on a lattice
- From: mcmcclur at unca.edu
- Date: Sat, 22 Sep 2007 03:26:19 -0400 (EDT)
- References: <fcvr81$7r9$1@smc.vnet.net>
On Sep 21, 3:18 am, Gareth Russell <russ... at njit.edu> wrote:
> Is there any way to use the built-in clustering routines to find
> clusters of ajacent elements on a 2d lattice?
Interesting question. I'll be interested to see if someone
has a cluster based approached. It seems to me that the
metrics available to the clustering functions don't select
contiguous data, as I suspect you are looking for.
Nonetheless, here's one option. There is some optimization
that could clearly be done, but it finds 237 groups in your
example data in a couple of minutes.
(* Your example, translated to points *)
SeedRandom[1];
testMap = Last[CellularAutomaton[
{1018, {2, {{0, 2, 0}, {2, 1, 2}, {0, 2, 0}}}, {1, 1}},
Table[If[Random[Real] < 0.1, 1, 0],{100},{100}],10]];
mappts = Position[testMap, 1];
(* Functions to group contiguous data *)
neighborhood[{x_Integer, y_Integer}] := Select[
Flatten[Table[{x + i, y + j},
{i, -1, 1}, {j, -1, 1}], 1],
MemberQ[mappts, #] &];
neighborhood[pts : {{_Integer, _Integer} ..}] := Union[
Flatten[neighborhood /@ pts, 1]];
group[pt_] := FixedPoint[neighborhood, pt];
(* Collection of the data into groups, *)
(* with a little timer. The speed increases*)
i = 0;
Clear[groups];
t = AbsoluteTime[];
While[Length[mappts] > 0,
Print[i, " - ", AbsoluteTime[] - t];
groups[++i] = group[mappts[[1]]];
mappts = Complement[mappts, groups[i]];]
The parameter i now indicates the number of groups.
You can visualize the separate groups as follows:
Show[MapIndexed[ListPlot[#, PlotStyle ->
Hue[#2[[1]]/100]] &, groups /@ Range[i]]]
Mark