Counting adjacent elements in a Matrix?

To start, I have a situation where I have some matrix, for example

$$A=\left[ \begin{matrix} 4&2&2&3&3\\ 2&3&1&2&3\\ 3&0&4&0&4\\ 1&4&1&1&2\\ 1&3&4&1&4\\ \end{matrix} \right]$$

and I would like to count how many adjacent elements there are. Adjacent elements can be up, down, left or right. For a pair to be valid the numbers have to have the same value. For example $\left(A_{1,2},A_{1,3}\right)$ is a valid pair because the are both $2$ and they are next to each other. I need a way to count the defined adjacent element pairs on a matrix of size $n$.

eg.

$$\left[ \begin{matrix} 2&2&3\\ 3&2&3\\ 2&1&1 \end{matrix} \right]$$

There would be 4 pairs in this matrix.

I thought about converting the matrix into some sort of graph with "weighted vertices" however I had no clue on doing so. It would have then made it a matter of counting arcs. So how would one produce a function that takes in a matrix and spits out the number of pairs (by my definition) it contains?

I am unsure whether or not I have tagged this correctly.

• Question is not clear to me, e.g., would the 2-4 elements of which there are four pairings in your example count as 1 total?
– ciao
Jan 16 '14 at 21:03
• @rasher Apologies about ambiguity I changed it. I also added an example Jan 16 '14 at 21:05
• If I understand correctly, this should accomplish the count you want. I treat a row, e.g, of x,x,x as two pairs. Try it and reply... (Count[{Differences /@ #}, 0, Infinity] + Count[{Differences /@ Transpose[#]}, 0, Infinity]) &[yourMatrixHere]
– ciao
Jan 16 '14 at 21:28
• A one-liner: Count[Flatten@{Differences[a, {1,0}], Differences[a, {0,1}]}, 0], where the matrix is a. Jan 16 '14 at 21:46
• @Szabolcs Would it be possible to use this method to determine, in a matrix defined as mat = RandomChoice[{0, 1, 2}, {5, 5}], the number of 1s that have 0s adjacent to them (i.e. up, down, left, right)?
– jbl
Feb 11 '21 at 22:56

This method generates all neighboring position-pairs (according to nontoroidal Neumann neighborhood) and then checks whether any of these position-pairs is a valid pair (i.e. identical) or not.

size= 5;
mat = RandomInteger[{1, 5}, {size, size}];
close = Cases[Tuples[Tuples[Range@size, {2}], {2}],
{{a_, b_}, {c_, d_}} /; (a==c && b==d-1) || (a==c-1 && b==d)]
pairs = Cases[close, _?(SameQ @@ Extract[mat, #] &)]

Grid[mat, Background -> {None, None, Thread[# -> Hue[.66, .2]]}] & /@ pairs
{{{1, 2}, {1, 3}}, {{1, 4}, {1, 5}}, {{2, 2}, {2, 3}}, {{2, 4},
{2, 5}}, {{2, 4}, {3, 4}}, {{3, 4}, {4, 4}}, {{5, 4}, {5, 5}}} – ciao
Jan 16 '14 at 22:52

This uses pattern-based rather than numeric methods and therefore will not be highly efficient, but I like the style.

f[a_?MatrixQ] :=
h[{{i_, x_}, {y_, _}}] := Count[{x, y}, i];
Developer`PartitionMap[h, a, {2, 2}, 1, 1, pad] ~Total~ 2
]

Test:

a = {{4, 2, 2, 3, 3}, {2, 3, 1, 2, 3}, {3, 0, 4, 0, 4}, {1, 4, 1, 1, 2}, {1, 3, 4, 1, 4}};
m = {{2, 2, 3}, {3, 2, 3}, {2, 1, 1}};

f /@ {a, m}
{6, 4}
• Nice approach ! Jan 17 '14 at 14:28
• @belisarius Thanks. :-) Jan 17 '14 at 14:32
• Stylish +1! Why pad the array and not stop before going over the borders? Also, adding the \$ in the Module seems like a good idea
– Rojo
Jan 17 '14 at 14:56
• @Rojo Because I'm stupid and/or lazy? :o) Good ideas! Jan 17 '14 at 15:00
• @Rojo Actually I don't think I can avoid the padding in a single Partition operation, unless I'm missing something. There is only one wasted check, for the lower right corner; all other overlaps are valid. Jan 17 '14 at 15:04

Following @rasher 's idea, you could do

Or, maybe speed it a little bit by counting with Unitize as @belsarius's superbly suggests

countAdj= -Total[Unitize@Differences@# - 1 & /@ {#, Transpose@#}, Infinity]&;

Or @Szabolcs magestic one-liner

countAdj= Count[Flatten@{Differences[#, {1,0}], Differences[#, {0,1}]}, 0]&

Some Code Golf:

Count[Differences /@ {#, #\[Transpose]}, 0, 3] &
• You don't need to map Differences, you can use it directly. E.g. Count[Flatten@Differences[a], 0]. Jan 16 '14 at 21:45
• @Szabolcs it just counts in the other direction, which is perfect anyway. Editing
– Rojo
Jan 16 '14 at 21:47
• -Total[Unitize@Differences@# - 1 & /@ {m, Transpose@m}, 3] Jan 16 '14 at 21:47
• @belisarius I expected that subtracting one to a whole matrix would be slower but no. I don't deserve any credits for this
– Rojo
Jan 16 '14 at 21:49
• I wonder if there isn't a ListConvolve kernel that can count both horiz and vert matches in one pass Jan 16 '14 at 21:54

Position of pairs:

posf[u_] := Module[{a, at, p1, p2},
{a, at} = Position[Differences /@ #, 0] & /@ {u, Transpose@u};
p1 = {#, # + {0, 1}} & /@ a;
p2 = {#, # + {1, 0}} & /@ (Reverse /@ at);
Join[p1, p2]]

Test matrix:

mat={{3, 5, 2, 2, 5}, {4, 2, 2, 1, 3}, {1, 2, 2, 1, 1}, {1, 1, 4, 1,
5}, {3, 2, 2, 3, 4}}; posf[mat]

yields:

{{{1, 3}, {1, 4}}, {{2, 2}, {2, 3}}, {{3, 2}, {3, 3}}, {{3, 4}, {3,
5}}, {{4, 1}, {4, 2}}, {{5, 2}, {5, 3}}, {{3, 1}, {4, 1}}, {{2,
2}, {3, 2}}, {{1, 3}, {2, 3}}, {{2, 3}, {3, 3}}, {{2, 4}, {3,
4}}, {{3, 4}, {4, 4}}}

Visualizing using:

Map[Function[x,
Grid[mat, Background -> {None, None, # -> LightRed & /@ x}]]
, posf[mat]] To obtain the count:

Length@posf[mat]

In this case yielding: 12.