# Given a list of positions in a matrix, get elements within radius r

I have a n x n binary matrix like

SeedRandom[1]; mat = RandomInteger[1, {9, 9}];
MatrixForm[mat]


I want to create partitions of radius r centered on the 1 elements.

If I have a border element at position {9, 1} and r = 3, as in the example above, I want to obtain {{0,1,1}, {0,0,1},{1,1,1}}

I know that Position[mat , 1] will give me the appropriate indices, but I haven't found in the documentation how to create partitions like the ones I want using Take, Part or Partition.

Using mat provided:

f[r_, {i_, j_}] := Module[{ind = Tuples[Range[9], 2], pos},

pos = Select[ind, ChessboardDistance[#, {i, j}] <= r - 1 &]; {pos,
Extract[mat, #] & /@ GatherBy[pos
, First]}]


Visualizing:

 Manipulate[With[{res = f[r, p]},
{ps, v} = res;
Row[{ArrayPlot[ReplacePart[mat, Thread[ps -> Flatten@v + 2]],
ColorRules -> {2 -> Red, 3 -> Green}], ArrayPlot[v],
MatrixForm[v]}]], {{r, 3}, {2, 3, 4}}, {{p, {9, 1}},


• Excellent code! Oct 11, 2015 at 4:41
• @thils that is kind...I altered to stop repeated function calls in body. You approached general case...boundaries are always tricky...also constructive rather than my select approach will be better for very large arrays (i.e. finding 'neighbours' directly rather than filtering)...this was fun and I hope motivating... Oct 11, 2015 at 4:58
SeedRandom[1];

mat = RandomInteger[1, {9, 9}]; MatrixForm[mat];

MatrixForm[
Flatten[Table[mat[[6 + i ;; -(4 - i), 1 ;; 3]], {i, 1, 3}], 1]]


General n,r

SeedRandom[1];
Manipulate[mat = RandomInteger[1, {n, n}]; MatrixForm[mat];
MatrixForm[
Flatten[Table[mat[[n - r + i ;; -(r + 1 - i), 1 ;; r]], {i, 1, r}],
1]],
{n, {9, 10, 20, 30}}, {r, {3, 4, 5}}]


You can also use Clip

Transpose[Clip[pos + # & /@ {-r, r}, {1, n}]]


to get the positions within a radius r of pos.

Manipulate[SeedRandom[1]; mat = RandomInteger[1, {n, n}];
Grid[MapIndexed[Setter[Dynamic@x, {#2}, #, ImageSize -> {30, 30},
Appearance -> "Frameless"]&, Style[#, 20, Bold] & /@ # & /@ mat, {2}],
ItemStyle -> {Automatic, Automatic,
{Dynamic@Transpose[Clip[x + # & /@ {-r, r}, {1, n}]] -> Directive[Red,  Bold],
Dynamic[x] -> Green}}, Spacings -> {0, 0}],
Row[{Control@{{n, 9}, Range[8, 12], SetterBar},
Control@{{r, 1}, Range[4], SetterBar}}, Spacer[20]], {mat, None}, Alignment -> Center]