Finding the position of similar elements in a matrix

I want to find the position of the elements which are equal in a matrix. For example in the case of the following matrix:

$m =\left( \begin{array}{cc} a & x \\ x & a \\ \end{array} \right)$

m = {{a, x}, {x, a}};


I want to get these two sets:

{{{1, 2}, {2, 1}}, {{1, 1}, {2, 2}}}


How can I do that? Is there a built in function?

• You should provide a bigger matrix.
– Öskå
Commented Jun 11, 2014 at 14:38

Here is a method that has far better computational complexity than Position:

f1[m_] := Cases[Last @ Reap @ MapIndexed[Sow[#2, #] &, m, {2}], {_, __}]


Test:

SeedRandom[0]
m = RandomInteger[5, {4, 4}];
m // MatrixForm


$\left( \begin{array}{cccc} 5 & 1 & 0 & 4 \\ 0 & 4 & 1 & 2 \\ 1 & 0 & 3 & 3 \\ 4 & 2 & 0 & 4 \end{array} \right)$

f1[m]

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


Alternative code; it is slightly faster than f1 in version 7, but might faster (or slower) in newer versions:

f2[m_] := Module[{x}, Cases[ArrayRules[m, x] ~GatherBy~ Last, {_, __}][[All, All, 1]] ];


To my consternation I tried the same method that rasher recently posted but I managed to lose the potential performance of that method. My mistake was to use Extract[m, #] & instead of m[[#[[1]], #[[2]]]] &. I expected Extract to be at least as fast; I still don't know why it is not. Nevertheless my revised f3:

f3[m_] := GatherBy[Tuples @ Range @ Dimensions @ m, m[[#[[1]], #[[2]]]] &] ~Cases~ {_, __}


Timings

Comparative timings with Öskå's pos. Timing function:

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]


On small arrays my functions are only a few times faster. (f3 is already much faster.)

m = RandomInteger[40, {15, 20}];
Scan[Print @ timeAvg @ #[m] &, {pos, f1, f2, f3}]


0.0005984
0.00020992
0.0002096
0.000089856

But as the array size and especially number of unique elements increases pos rapidly slows down:

m = RandomInteger[500, {40, 70}];
Scan[Print @ timeAvg @ #[m] &, {pos, f1, f2, f3}]


0.04744
0.0020464
0.0019968
0.000848

m = RandomInteger[3000, {120, 160}];
Scan[Print @ timeAvg @ #[m] &, {pos, f1, f2, f3}]


2.792
0.02372
0.02308
0.005872

m = RandomInteger[10000, {300, 400}];
Scan[Print @ timeAvg @ #[m] &, {pos, f1, f2, f3}]   (* warning: very slow! *)


122.991
0.2404
0.2404
0.04244

• @rasher Thank you. Commented Jun 12, 2014 at 7:07

How about that? I believe that you should provide a bigger example though.

m = {{a, x}, {x, a}}
pos[m_] :=
Position[m, #] & /@ First /@ Select[Tally@Flatten@m, Last@# >= 2 &]
pos@m


{{{1, 1}, {2, 2}}, {{1, 2}, {2, 1}}}

SeedRandom@0;
mat = RandomChoice[Range@25, {5, 5}]


$\left( \begin{array}{ccccc} 21 & 5 & 3 & 3 & 23 \\ 8 & 17 & 3 & 3 & 4 \\ 20 & 2 & 25 & 11 & 22 \\ 13 & 18 & 12 & 23 & 13 \\ 19 & 22 & 2 & 3 & 2 \\ \end{array} \right)$

pos@mat//Column

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


If one wants to illustrate their position in a colorful way:

SeedRandom@0;
mat /. (Rule[#, Style[#, RGBColor@RandomReal[{}, 3]]] & /@ (First /@
Select[Tally@Flatten@mat, Last@# >= 2 &])) // MatrixForm


• Thank you. The first edition of your answer was fine. Why did you change that? What is the difference? Position[m, #] & /@ First /@ Tally@Flatten@m
– MOON
Commented Jun 11, 2014 at 14:52
• It's different if you have one single variable: {{a,x},{b,a}} where only a is repeated. With the first version you would have the position of x and b while they are not repeated, with this one you only have the position of the elements repeated at least twice.
– Öskå
Commented Jun 11, 2014 at 14:55
• Öskå, be aware that repeated use of Position can be very slow. Please see my answer for an alternative and timing examples. Commented Jun 11, 2014 at 18:44
• @Mr.Wizard Well well well.., 122 seconds is quite long indeed.. :) I should really get into Reap/Sow.
– Öskå
Commented Jun 11, 2014 at 18:53

About 10X faster than fastest so far posted using timeAvg from above...

fr= With[{a = Flatten[Array[List, Dimensions@#], 1], l = #},GatherBy[a, l[[#[[1]], #[[2]]]] &]] &


Quick test of the fastest using timeAvg with data generated as m = RandomInteger[size, {size, size}], with the usual loungebook caveats... I did not include Position based solution, as Mr. Wizard noted it explodes time-wise with larger problems.

Addressing RunnyKine's comment re: singlets (I chose to include them, since OP does not specify treatment of these precisely), and switching Kguler's to his fixed version:

frX=Cases[With[{a = Flatten[Array[List, Dimensions@#], 1], l = #},
GatherBy[a, l[[#[[1]], #[[2]]]] &]], {_, __}] &


No material difference in timings (fr and frX lie on top of each other here, average difference in time treating singlets per comment is <5%)...

• @RunnyKine: since the OP does not specify precisely what "same" is, a bit irrelevant, clearly a singlet is the same as itself.. Nonetheless, simply adding Cases to filter that still results in only ~10% overhead, so still vastly faster. I'll update plot to reflect this.
– ciao
Commented Jun 12, 2014 at 1:57
• Very strange. I actually tried what I thought was very similar to this and it wasn't faster. However I can confirm that this is. I wish I had that old code to compare because I'd really like to know what I did wrong to kill the potential of this method! +1 of course. Commented Jun 12, 2014 at 4:11
• Please see my updated answer. Can you explain why Extract was slow here? Commented Jun 12, 2014 at 4:22
• By the way, for future timing graphs I highly recommend using LogPlot -- it makes it much easier to see the order of complexity. Commented Jun 12, 2014 at 4:29
• After some consideration I guess m[[ #[[1]], #[[2]] ]] & can be compiled since the depth of extraction is explicit, whereas Extract[m, #] & cannot be. I really hate having to use the long form however. Commented Jun 12, 2014 at 7:02

Here is a method using the new-in-version-10 PositionIndex function.

f4[m_] :=
m // Flatten // PositionIndex // Values // Cases[{_, __}] //
(1 + IntegerDigits[# - 1, Length @ First @ m, 2] &)


Test:

SeedRandom[0]
m = RandomInteger[5, {4, 4}];

f4[m]

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


This is not as fast as my earlier f3 but I think it is an interesting variation, hopefully worthy of posting.