Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

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



  • Prev by Date: Re: Can an arrow be drawn on a 3D plot?
  • Next by Date: Re: Labeling longitudes and latitudes
  • Previous by thread: Identifying clusters of adjacent points on a lattice
  • Next by thread: Re: Identifying clusters of adjacent points on a lattice