正确使用 Mathematica Gather/Collect

Question

如何使用 Mathematica 的 Gather/Collect/Transpose 函数进行转换：

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

到

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

编辑：谢谢！我希望有一个简单的方法，但我想没有！

Answer 1

这是你的清单：

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

这是一种方法：

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

编辑

这是一个完全不同的版本，只是为了好玩：

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

编辑 2

这里还有另一种方法，使用链表和内部函数来累积结果：

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

编辑 3

好的，对于那些认为以上所有内容都过于复杂的人，这里有一个非常简单的基于规则的解决方案：

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

Answer 2

也许更容易：

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

Answer 3

地图线程

如果“foo”和“bar”子列表保证相互对齐（如示例中所示），并且您将考虑使用Gather/Collect/Transpose以外的函数，那么MapThread 就足够了：

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

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

结果：

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

模式匹配

如果列表不对齐，您也可以使用直接模式匹配和替换（尽管我不建议将这种方法用于大型列表）：

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

播种/收获

一种更有效的未对齐列表方法使用Sow 和Reap：

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

Answer 4

也只是为了好玩......

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

在哪里

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

编辑。

更多乐趣...

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

Answer 5

下面是我使用我在What is in your Mathematica tool bag? 中发布的 SelectEquivalents 版本的方法

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

这个方法很通用。我以前使用诸如 GatherBy 之类的函数来处理我在 Monte-Carlo 模拟中生成的巨大列表。现在使用 SelectEquivalents 实现此类操作更加直观。此外，它基于 Mathematica 中非常快的 Reap 和 Sow 组合。

Answer 6

在问题更新为更清晰和具体之前，我会假设我想要的，并提出以下建议：

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

见：UnsortedUnion

Answer 7

可能有点过于复杂，但是：

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

这是如何工作的：

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

返回每个列表项的唯一第一个元素，按照它们被播种的顺序（因为DeleteDuplicates 从不重新排序元素）。那么，

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

利用Reap 返回在不同列表中使用不同标签播种的表达式这一事实。然后把它们放在一起，然后转置。

这样做的缺点是要扫描两次。

编辑：

这个

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

（非常）快一点，但可读性更差......