Using Mathematica Gather/Collect properly

Question

How do I use Mathematica's Gather/Collect/Transpose functions to convert:

{ { {1, foo1}, {2, foo2}, {3, foo3} }, { {1, bar1}, {2, bar2}, {3, bar3} } }

to

{ {1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3} }

EDIT: Thanks! I was hoping there was a simple way, but I guess not!

IMHO the functional requirement could have been written somewhat better. Your example leaves much to be guessed. — Sjoerd C. de Vries, Aug 07 '11 at 20:38
Yes, please update the question to be more specific. Currently it is quite ambiguous. — Mr.Wizard, Aug 13 '11 at 14:17

Leonid Shifrin · Accepted Answer · 2011-08-07T18:56:06.217

Here is your list:

tst = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3,  bar3}}}

Here is one way:

In[84]:= 
Flatten/@Transpose[{#[[All,1,1]],#[[All,All,2]]}]&@
  GatherBy[Flatten[tst,1],First]

Out[84]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}

EDIT

Here is a completely different version, just for fun:

In[106]:= 
With[{flat = Flatten[tst,1]},
   With[{rules = Dispatch[Rule@@@flat]},
       Map[{#}~Join~ReplaceList[#,rules]&,DeleteDuplicates[flat[[All,1]]]]]]

Out[106]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}

EDIT 2

And here is yet another way, using linked lists and inner function to accumulate the results:

In[113]:= 
Module[{f},f[x_]:={x};
  Apply[(f[#1] = {f[#1],#2})&,tst,{2}];
  Flatten/@Most[DownValues[f]][[All,2]]]

Out[113]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}

EDIT 3

Ok, for those who consider all of the above too complicated, here is a really simple rule - based solution:

In[149]:= 
GatherBy[Flatten[tst, 1], First] /. els : {{n_, _} ..} :> {n}~Join~els[[All, 2]]

Out[149]= {{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}

In Edit 3, what does `els :` mean, or do? Is it a way to name the pattern that follows? — DavidC, Aug 07 '11 at 20:07
@David: The standard `x_` is actually short for `x:_`, but the former is so common that many people don't recognize the latter. Both are read "the pattern named `x` that matches `Blank[]`". — Simon, Aug 07 '11 at 22:29

score 7 · Answer 2 · answered Aug 07 '11 at 18:47

7

Perhaps easier:

tst = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3,  bar3}}};

GatherBy[Flatten[tst, 1], First] /. {{k_, n_}, {k_, m_}} -> {k, n, m}
(*
-> {{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}
*)

answered Aug 07 '11 at 18:47

Dr. belisarius

60,527
15
115
190

I did not see you solution until my last edit. I was thinking along the same lines, but the main problem that took me some time to figure out was to handle arbitrary number of terms in the sublists in the rule-based approach - yours only handles exactly two terms. – Leonid Shifrin Aug 07 '11 at 19:17
@Leonid You are right, but I am not sure if such generalization is asked for in the question – Dr. belisarius Aug 07 '11 at 19:22

WReach · Answer 3 · 2011-08-07T19:58:41.377

MapThread

If the "foo" and "bar" sublists are guaranteed to be aligned with one another (as they are in the example) and if you will consider using functions other than Gather/Collect/Transpose, then MapThread will suffice:

data={{{1,foo1},{2,foo2},{3,foo3}},{{1,bar1},{2,bar2},{3,bar3}}};

MapThread[{#1[[1]], #1[[2]], #2[[2]]}&, data]

result:

{{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}

Pattern Matching

If the lists are not aligned, you could also use straight pattern matching and replacement (although I wouldn't recommend this approach for large lists):

data //.
  {{h1___, {x_, foo__}, t1___}, {h2___, {x_, bar_}, t2___}} :>
  {{h1, {x, foo, bar}, t1}, {h2, t2}} // First

Sow/Reap

A more efficient approach for unaligned lists uses Sow and Reap:

Reap[Cases[data, {x_, y_} :> Sow[y, x], {2}], _, Prepend[#2, #1] &][[2]]

681234 · Answer 4 · 2011-08-08T17:03:19.720

4

Also just for fun ...

DeleteDuplicates /@ Flatten /@ GatherBy[Flatten[list, 1], First]

where

list = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, 
    bar3}}}

Edit.

Some more fun ...

Gather[#][[All, 1]] & /@ Flatten /@ GatherBy[#, First] & @ 
 Flatten[list, 1]

edited Aug 08 '11 at 17:03

answered Aug 07 '11 at 19:53

681234

4,214
2
35
42

@Simon yes, that's the most direct way to do it. but where's the fun in that? :) – acl Aug 08 '11 at 00:34
@Simon. I didn't see your code. I posted this just as WReach posted his answer. I thought about deleting it but decided to leave it there ... – 681234 Aug 08 '11 at 07:07
@TomD: I didn't post my code - since you beat me to it. So I upvoted your answer instead - leave it or my vote is wasted! – Simon Aug 08 '11 at 11:18
@Simon Thanks! Upvotes are scarce of late (but I am learning a lot) :-) – 681234 Aug 08 '11 at 16:48

score 4 · Answer 5 · edited May 23 '17 at 11:47

Here is how I would do it using the version of SelectEquivalents I posted in What is in your Mathematica tool bag?

l = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, bar3}}};

SelectEquivalents[
   l
   ,
   MapLevel->2
   ,
   TagElement->(#[[1]]&)
   ,
   TransformElement->(#[[2]]&)
   ,
   TransformResults->(Join[{#1},#2]&)
]

This method is quite generic. I used to use functions such as GatherBy before for treating huge lists I generate in Monte-Carlo simulations. Now with SelectEquivalents implementations for such operations are much more intuitive. Plus it is based on the combination Reap and Sow which is very fast in Mathematica.

score 3 · Answer 6 · edited May 23 '17 at 12:04

3

Until the question is updated to be more clear and specific, I will assume what I want to, and suggest this:

UnsortedUnion @@@ #~Flatten~{2} &

See: UnsortedUnion

edited May 23 '17 at 12:04

Community

1
1

answered Aug 13 '11 at 14:24

Mr.Wizard

24,179
5
44
125

1

Welcome back mr.wizard. Had a good vacation? Did you see this question (http://stackoverflow.com/q/6505675/615464)? I think you'll like it ;-) – Sjoerd C. de Vries Aug 13 '11 at 22:43
@Sjoerd Thanks, and yes. No, I had not. LOL! – Mr.Wizard Aug 15 '11 at 21:05

acl · Answer 7 · 2011-08-07T18:14:07.423

Maybe a bit overcomplicated, but:

lst = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, bar3}}}

Map[
    Flatten,
    {Scan[Sow[#[[1]]] &,
                Flatten[lst, 1]] // Reap // Last // Last // DeleteDuplicates,
    Scan[Sow[#[[2]], #[[1]]] &,
            Flatten[lst, 1]] // Reap // Last} // Transpose
]
(*
{{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}
*)

Here's how this works:

Scan[Sow[#[[1]]] &,
    Flatten[lst, 1]] // Reap // Last // Last // DeleteDuplicates

returns the unique first elements of each of your list items, in the order they were sown (since DeleteDuplicates never reorders elements). Then,

Scan[Sow[#[[2]], #[[1]]] &,
        Flatten[lst, 1]] // Reap // Last

exploits the fact that Reap returns expressions sown with difference tags in different lists. So then put them together, and transpose.

This has the disadvantage that we scan twice.

EDIT:

This

Map[
    Flatten,
    {DeleteDuplicates@#[[1]],
            Rest[#]} &@Last@Reap[
                Scan[(Sow[#[[1]]]; Sow[#[[2]], #[[1]]];) &,
                    Flatten[lst, 1]]] // Transpose
]

is (very) slightly faster, but is even less readable...

Using Mathematica Gather/Collect properly

7 Answers7

Linked