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