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

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

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

回答1:

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

回答2:

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

回答3:

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

回答4:

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.

回答5:

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]

回答6:

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

回答7:

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

来源：https://stackoverflow.com/questions/6974544/using-mathematica-gather-collect-properly

标签

wolfram-mathematica