5

I would like to define a function with the following properties: Given a list of equal length sub-lists

ls={{a,a,a},{a,b,a},{a,b,c}};

Define a function 

Slort[ls,1]

to return

{{1,2,3}} (* all three sub-lists have the same first element *)

Slort[ls,2]
{{1},{2,3}} (* sub-lists 2 and 3 have the same second element, sub-list 1 is unique *)

Slort[ls,3]
{{1,2},{3}} (* sub-list 1 and 2 have the same third element, sub-list 3 is unique *)

and etc.

With your help I should then be able to extend the number of sub-lists and the number of elements in each sub-list myself.

Phillip Dukes
  • 938
  • 5
  • 18

2 Answers2

4

This question is a generalized version of the question How to efficiently find positions of duplicates?. The following is a generalization of this answer by Szabolcs:

ClearAll[Slort]
Slort[lst_, pos_] := GatherBy[Range@Length@lst, lst[[#, pos]] &]

Examples:

ls = {{a, a, a}, {a, b, a}, {a, b, c}};

Slort[ls, #]& /@ Range[3]

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

SeedRandom[1]
ls2 = RandomChoice[{a, b, c, d}, {10, 5}];

Slort[ls2, #] & /@ Range[5] // MatrixForm

Mathematica graphics

kglr
  • 394,356
  • 18
  • 477
  • 896
2

A late alternative to kglrs elegant solution:

list = {{a, a, a}, {a, b, a}, {a, b, c}};

Slort[lst_, pos_] :=
   Flatten /@ GroupBy[First -> Last] @ MapIndexed[List] @ Transpose[lst][[pos]]

Slort[list, #] & /@ {1, 2, 3} // TableForm

enter image description here

We can use Values to get the desired output form:

Values @ Slort[list, 2]

{{1}, {2, 3}}

Update

Since V10 we can use PositionIndex:

Slort2[lst_, pos_] := Map[Values@*PositionIndex][Transpose@lst][[pos]]
eldo
  • 67,911
  • 5
  • 60
  • 168
  • Nice. A slight variant on Slort2 (which I hope I have got right on this third attempt): slort2[lst_, pos_] := (PositionIndex@(Transpose@lst)[[pos]] // Values). – user1066 Jun 20 '17 at 20:55