Merging and keeping only the sublists whose first two elements are equal

Question

I have a list containing sublists.

list= {{-9, 3, 2}, {-9, 3, 8}, {-9, 4, 3}, {-9, 4, 4}, {-7, 2, 2}, {-7, 2, 
  10}, {-7, 3, 4}, {-5, 1, 16}, {-5, 2, 4}, {-3, 1, 4}, {-3, 1, 
  6}, {3, 1, -14}, {3, 2, -8}, {3, 3, -6}, {3, 4, -5}, {3, 6, -4}, {7,
   5, -8}, {9, 10, -6}}.

I want to keep sublists whose first two elements match.

{-9, 3, 2}, {-9, 3, 8}, {-9, 4, 3}, {-9, 4, 4}, {-7, 2, 2}, {-7, 2, 10}, {-3, 1, 4}, {-3, 1, 6} and merge these sublists into:

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}

I would like to discard other sublists.

{-7, 3, 4}, {-5, 1, 16}, {-5, 2, 4},{3, 1, -14}, {3, 2, -8}, {3, 3, -6}, {3, 4, -5}, {3, 6, -4}, {7,5, -8}, {9, 10, -6}.

I tried by my hand to get {{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}.

How can I tell Mathematica to do it?

Answer 1

KeyValueMap[Join]@
 Select[Merge[GatherBy[Most@# -> Last@# & /@ list, First], Union], 
  Length@# == 2 &]

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}.

Answer 2

KeyValueMap[Join] @ 
 Select[Length @ # > 1 &] @ 
  GroupBy[list, Most -> Last]

 {{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}

Answer 3

$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global`*"]

list = {{-9, 3, 2}, {-9, 3, 8}, {-9, 4, 3}, {-9, 4, 4},
   {-7, 2, 2}, {-7, 2, 10}, {-7, 3, 4}, {-5, 1, 16},
   {-5, 2, 4}, {-3, 1, 4}, {-3, 1, 6}, {3, 1, -14},
   {3, 2, -8}, {3, 3, -6}, {3, 4, -5}, {3, 6, -4},
   {7, 5, -8}, {9, 10, -6}};

list2 = Flatten[{Most[#[[1]]], #[[All, -1]]}] & /@
  DeleteCases[GatherBy[list, Most], _?(Length[#] == 1 &)]

(* {{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}} *)

Answer 4

Clear["Global`*"];
list = {{-9, 3, 2}, {-9, 3, 8}, {-9, 4, 3}, {-9, 4, 4}, {-7, 2, 
    2}, {-7, 2, 10}, {-7, 3, 4}, {-5, 1, 16}, {-5, 2, 4}, {-3, 1, 
    4}, {-3, 1, 6}, {3, 1, -14}, {3, 2, -8}, {3, 3, -6}, {3, 
    4, -5}, {3, 6, -4}, {7, 5, -8}, {9, 10, -6}};


GroupBy[list, #[[1 ;; 2]] &] // Select[Length@# > 1 &] // 
 KeyValueMap[Catenate@{#1, Flatten@#2[[All, 3 ;;]]} &]

---

Another journey:

First find duplicated keys.

k = CountsBy[list, #[[1 ;; 2]] &] // Select[# > 1 &] // Keys

{{-9, 3}, {-9, 4}, {-7, 2}, {-3, 1}}

list //
    Map[Apply[Rule]]@*Map[TakeDrop[#, 2] &] //
   Merge[#, Catenate] & //
  KeySelect[#, MemberQ[k, #] &] & //
 KeyValueMap[Join]

---

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}

Answer 5

fun[{a_, b_} -> {c_, d_}] := {a, b, c, d}
fun[_] := Nothing

fun /@ Normal @ Merge[# &] @ Cases[{a__, b_} :> {a} -> b] @ list

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}

Answer 6

Kludgy, but it works without removing duplicates from the resulting lists

list = {{-9, 3, 2}, {-9, 3, 8}, {-9, 4, 3}, {-9, 4, 4}, {-7, 2, 
   2}, {-7, 2, 10}, {-7, 3, 4}, {-5, 1, 16}, {-5, 2, 4}, {-3, 1, 
   4}, {-3, 1, 6}, {3, 1, -14}, {3, 2, -8}, {3, 3, -6}, {3, 
   4, -5}, {3, 6, -4}, {7, 5, -8}, {9, 10, -6}};

Count replicates by the first two elements of each sublist:

t1 = Tally[list[[All, {1, 2}]]]
 (* {{{-9, 3}, 2}, {{-9, 4}, 2}, {{-7, 2}, 2}, {{-7, 3}, 1}, {{-5, 1}, 
  1}, {{-5, 2}, 1}, {{-3, 1}, 2}, {{3, 1}, 1}, {{3, 2}, 1}, {{3, 3}, 
  1}, {{3, 4}, 1}, {{3, 6}, 1}, {{7, 5}, 1}, {{9, 10}, 1}} *)

Keep the ones that have two replicates:

t2 = Cases[t1, {x___, 2} -> x]
 (* {{-9, 3}, {-9, 4}, {-7, 2}, {-3, 1}} *)

Get the matching elements from the original list:

t3 = Cases[list, {# /. List -> Sequence, _}] & /@ t2
 (* {{{-9, 3, 2}, {-9, 3, 8}}, {{-9, 4, 3}, {-9, 4, 4}}, {{-7, 2, 2}, {-7,
    2, 10}}, {{-3, 1, 4}, {-3, 1, 6}}} *)

Combine the matching elements:

t4 = Join[#[[1, {1, 2}]], #[[All, 3]]] & /@ t3

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}

Answer 7

Another way using Select and Subsets:

Join @@ # & /@ Map[DeleteDuplicates, Transpose /@ Select[Subsets[list, {2}],
Most@#[[1]] == Most@#[[2]] &], {2}]

(*{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}*)

Answer 8

la =
  {{-9, 3, 2}, {-9, 3, 8}, {-9, 4, 3}, {-9, 4, 4}, {-7, 2, 2}, 
   {-7, 2, 10}, {-7, 3, 4}, {-5, 1, 16}, {-5, 2, 4}, {-3, 1, 4}, 
   {-3, 1, 6}, {3, 1, -14}, {3, 2, -8}, {3, 3, -6}, {3, 4, -5}, 
   {3, 6, -4}, {7, 5, -8}, {9, 10, -6}};

Using SequenceCases

SequenceCases[la, {{a_, b_, c_}, {a_, b_, d_}} :> {a, b, c, d}]

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}

If the list is unsorted:

lb = {{4, 2, 2}, {5, 1, 6}, {4, 2, 3}};

SequenceCases[Sort @ lb, {{a_, b_, c_}, {a_, b_, d_}} :> {a, b, c, d}]

{{4, 2, 2, 3}}

Answer 9

Using SplitBy and Select:

f1 = Map[First]@Most@#~Join~Last@# &@Thread@# &;

f2 = Select[SplitBy[Sort@#, Most@# &], Length@# > 1 &] &;

f1 /@ f2@list

{{-9, 3, 2, 8}, {-9, 4, 3, 4}, {-7, 2, 2, 10}, {-3, 1, 4, 6}}