Select lists where last elements are identical

Question

Given the following list

t1 = {{5, 5, 50}, {6, 1, 37}, {6, 2, 40}, {6, 3, 45}, {7, 4, 65}, {7, 6, 85}, {8, 1, 65}, {6, 6, 72}, {7, 1, 50}};

I want to find those triples having the same element in the last position. Which results in

{{5, 5, 50}, {7, 4, 65}, {8, 1, 65}, {7, 1, 50}}

I can do it by:

t2 = Select[Tally[t1[[All, 3]]], Last[#] > 1 &][[All, 1]];
Select[t1, MemberQ[#, Alternatives @@ t2] &]

Any ideas for polishing this clumsy code?

Answer 1

Preserving the order:

With[{c = CountsBy[t1, Last]}, Select[t1, c[Last@#] > 1 &]]

Answer 2

If order is not important

t1 // GroupBy[Last] // Select[Length[#] > 1 &] // Values

(* {{{5, 5, 50}, {7, 1, 50}}, {{7, 4, 65}, {8, 1, 65}}} *)

Answer 3

GroupBy[Counts[t1[[All, -1]]]@#[[-1]] > 1 &][t1]@True

  {{5, 5, 50}, {7, 4, 65}, {8, 1, 65}, {7, 1, 50}}

Answer 4

Using GatherBy similarly to Rohit's GroupBy solution (I even emulate his style because I find it really nice):

GatherBy[t1, Last] // Select[Length[#] > 1 &] // Flatten[#, 1] &

{{5, 5, 50}, {7, 1, 50}, {7, 4, 65}, {8, 1, 65}}

To add a bit more novelty to the answer, I also submit these rule based solutions:

ReplaceList[
 SortBy[t1, Last],
 {___, l : Repeated[{_, _, x_}, {2, Infinity}], ___} :> l
 ]

{{5, 5, 50}, {7, 1, 50}, {7, 4, 65}, {8, 1, 65}}

SequenceCases[
  SortBy[t1, Last],
  {Repeated[{_, _, x_}, {2, Infinity}]}
  ] // Flatten[#, 1] &

{{5, 5, 50}, {7, 1, 50}, {7, 4, 65}, {8, 1, 65}}

Answer 5

Edit

Acting on the advice given here:

Pick[#1,Replace[#1[[All,#2]],Unitize[Counts[#1[[All,#2]]]-1],{1}],1]&@@{t1,-1}

---

Original Answer

Pick[#1,#1[[All,#2]]/.Unitize[Counts[#1[[All,#2]]]-1],1]&@@{t1,-1}

{{5, 5, 50}, {7, 4, 65}, {8, 1, 65}, {7, 1, 50}}

For identities at position 2 (if desired):

Pick[#1,#1[[All,#2]]/.Unitize[Counts[#1[[All,#2]]]-1],1]&@@{t1,2}

{{6, 1, 37}, {7, 6, 85}, {8, 1, 65}, {6, 6, 72}, {7, 1, 50}}

Answer 6

Via PositionIndex

t1[[Flatten @ Cases[{_, _}] @ PositionIndex[Last /@ t1]]]

{{5, 5, 50}, {7, 1, 50}, {7, 4, 65}, {8, 1, 65}}

If order is important we sort the positions:

t1[[Sort @ Flatten @ Cases[{_, _}] @ PositionIndex[Last /@ t1]]]

{{5, 5, 50}, {7, 4, 65}, {8, 1, 65}, {7, 1, 50}}

Answer 7

Using Subsets and Select:

t1 = {{5, 5, 50}, {6, 1, 37}, {6, 2, 40}, {6, 3, 45}, {7, 4, 65},
      {7, 6, 85}, {8, 1, 65}, {6, 6, 72}, {7, 1, 50}};

Select[Subsets[t1, {2}], #[[1, 3]] == #[[2, 3]] &]

(*{{{5, 5, 50}, {7, 1, 50}}, {{7, 4, 65}, {8, 1, 65}}}*)