6
$\begingroup$

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.

$\endgroup$

3 Answers 3

7
$\begingroup$

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}}

$\endgroup$
6
  • $\begingroup$ 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? $\endgroup$
    – apt45
    Jul 21, 2019 at 18:08
  • 1
    $\begingroup$ @apt45, thank you. Fixed it. $\endgroup$
    – kglr
    Jul 21, 2019 at 18:10
  • $\begingroup$ Thank to you ;) ! $\endgroup$
    – apt45
    Jul 21, 2019 at 18:11
  • $\begingroup$ Hi again! Is there any way to speed up the algorithm when dealing with ~60000 columns and ~60 rows? Thanks! $\endgroup$
    – apt45
    Aug 21, 2019 at 23:13
  • $\begingroup$ Values@PositionIndex[Transpose[M]] is much more performant! I would suggest to add this to the answer. Cheers. $\endgroup$
    – apt45
    Aug 25, 2019 at 12:34
1
$\begingroup$

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}}

$\endgroup$
1
$\begingroup$
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@M1, #] &, elems@Thread@M1]

{{{1}, {2}}}

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

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.