# Find position equal columns of matrix

Consider the following rectangular matrix

M = {{1,1,1,1},{2,2,4,4},{3,3,5,5},{9,9,3,1}}


I would like to extract the position of equal columns. Is there a simple function or algorithm working with any matrix? By acting with a function (or using an algorithm) on M, I should get {1,2} as output.

More generally, there may be two sets of equal columns, as in the following case

 M = {{1,1,1,1},{2,2,4,4},{3,3,5,5},{9,9,3,3}}


in which case the output should be {{1,2},{3,4}}.

Is there something already implemented in Mathematica? I need a clever and fast algorithm which can be applied to big matrices of size 200x200.

You can use GatherBy and Select:

M = {{1, 1, 1, 1}, {2, 2, 4, 4}, {3, 3, 5, 5}, {9, 9, 3, 1}};

Select[GatherBy[Range[Length@M[[1]]], Transpose[M][[#]] &], Length[#] > 1 &]


{{1, 2}}

Also

 Select[Length @ # > 1&] @ Values @ PositionIndex[Transpose[M]]


{{1, 2}}

M2 = {{1, 1, 1, 1}, {2, 2, 4, 4}, {3, 3, 5, 5}, {9, 9, 3, 3}};

Select[GatherBy[Range[Length@M2[[1]]], Transpose[M2][[#]] &], Length[#] > 1 &]


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

 Select[Length @ # > 1&] @ Values @ PositionIndex[Transpose[M2]]


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

• Umh.. this does not work well. For example, the matrix posted here pastebin.com/BJZ6VmKe has the columns 14,17,24 equal.I think you should modify the command as Select[GatherBy[Range[Length@Transpose@M], Transpose[M][[#]] &], Length[#] > 1 &], right? Jul 21, 2019 at 18:08
• @apt45, thank you. Fixed it.
– kglr
Jul 21, 2019 at 18:10
• Thank to you ;) ! Jul 21, 2019 at 18:11
• Hi again! Is there any way to speed up the algorithm when dealing with ~60000 columns and ~60 rows? Thanks! Aug 21, 2019 at 23:13
• Values@PositionIndex[Transpose[M]] is much more performant! I would suggest to add this to the answer. Cheers. Aug 25, 2019 at 12:34

Using SequencePosition (new in 10.1)

a = {{1, 1, 1, 1}, {2, 2, 4, 4}, {3, 3, 5, 5}, {9, 9, 3, 1}};

SequencePosition[Transpose @ a, {x_, x_}]


{{1, 2}}

b = {{1, 1, 1, 1}, {2, 2, 4, 4}, {3, 3, 5, 5}, {9, 9, 3, 3}};

SequencePosition[Transpose @ b, {x_, x_}]


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

M1 = {{1, 1, 1, 1}, {2, 2, 4, 4}, {3, 3, 5, 5}, {9, 9, 3, 1}};

M2 = {{1, 1, 1, 1}, {2, 2, 4, 4}, {3, 3, 5, 5}, {9, 9, 3, 3}};


Using SequenceCases and Position:

elems = SequenceCases[#, s : {x_ , x_} :> Splice@s] &;


Union@Map[Position[Thread@M2, #] &, elems@Thread@M2]