Skip to main content
6 of 8
updated to address other posts
Virgil
  • 3.5k
  • 17
  • 27

Built-in option

This sidesteps most of your code, so it might not be what you are looking for, but I believe your goal can be achieved with Mathematica's built-in image processing capability, specifically: MorphologicalComponents!

Define a new clustering function

clustering1[config_] := Module[{output, csizes, cindices},
   output =  MorphologicalComponents[Image@Abs@config, CornerNeighbors -> False];
   csizes = Rest@Sort@Tally@Flatten@output;
   cindices = Module[
      {sa = SparseArray[output], xx, yy, sa1, sa2},
      sa1 = sa["NonzeroValues"];
      xx = GatherBy[Range@Length@sa1, sa1[[#]] &];
      sa2 = sa["NonzeroPositions"];
      yy = sa2[[#]] & /@ xx;
      Transpose[{sa1[[xx[[All, 1]]]], yy}]];
     ];
   {csizes, cindices, output}
  ];

and apply:

inputConfig = {{-1, -1, -1, 0}, {-1, 0, 0, -1}, {-1, -1, 0, -1}, {0, -1, 0, 0}};
clustering1@inputConfig
{{{1, 7}, {2, 2}}, 
 {{1, {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {3, 1}, {3, 2}, {4, 2}}}, {2, {{2, 4}, {3, 4}}}},
 {{1, 1, 1, 0}, {1, 0, 0, 2}, {1, 1, 0, 2}, {0, 1, 0, 0}}}

The first item in the output is the list of {clusterNumber, clusterSize}, the second the list of {clusterNumber, clusterIndices}, and the third is the input array with cluster numbers replacing filled sites.

EDIT

It appears that finding the cluster indices with Position is extremely slow with large datasets, although the rest of the code is relatively fast. With thanks to ciao (see below), I've replaced it with a much faster construction.

Mimicking the recursive algorithm

Here is my take on what the OP was actually asking for: a Mathematic approach to a recursive algorithm. The actual algorithm is not much changed - the use of Sow and Reap in the OP's code is a good idea, and I agree that the recursion needed is not amenable to Nest or Fold - all I can do is clean it up a little and exchange the Do for a Scan over the populated sites:

clustering2[config_] := Module[
   {output = config,
    cnum = 0, length = Length@config,
    csearch, clusters, c},
   
   csearch[{i_, j_}, cnum_] := If[
     output[[i, j]] == -1,
     output[[i, j]] = cnum;
     Sow[{i, j}];
     csearch[#, cnum] & /@ Select[
       {i, j} + # & /@ {{0, 1}, {0, -1}, {1, 0}, {-1, 0}},
       (1 <= First@# <= length && 1 <= Last@# <= length) &]
    ];
   
   clusters = Reap[
      Scan[
       If[output[[Sequence @@ #]] == -1,
          cnum++;
          c = Reap[csearch[#, cnum]][[2, 1]];
          Sow[{cnum, Length@c, c}]] &,
       SparseArray[config]["NonzeroPositions"]]
    ][[2, 1]];
   
   {clusters, output}
  ];

Applying this to inputConfig gives

{{{1, 7, {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {3, 1}, {3, 2}, {4, 2}}}, 
  {2, 2, {{2, 4}, {3, 4}}}}, 
 {{1, 1, 1, 0}, {1, 0, 0, 2}, {1, 1, 0, 2}, {0, 1, 0, 0}}}

The first item in the output is the list of {clusterNumber, clusterSize, clusterIndices} and the second is the input array with cluster numbers replacing filled sites.

I've run this on a 1000x1000 array with filling factor ~0.5, and although it is about 3 times slower than the first method, it does work.

Comments

I'd be interested to know if anybody can think of a more clever way of implementing the algorithm. Mathematica has the SparseArray object, which is a good fit for the input and output configurations we are dealing with here, so one might consider using those from the beginning for the input. Thanks to ciao, who pointed out that one can extract the positions of non-zero elements easily from a SparseArray with ["NonzeroElements"], we can restrict our attention to those only.

Virgil
  • 3.5k
  • 17
  • 27