Using Mathematica Gather/Collect properly

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!

---

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

---

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

---

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

---

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]

---

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.

---

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

---

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