使用Mathematica的Gather/Collect功能

Question

我该如何使用Mathematica的Gather/Collect/Transpose函数来转换以下内容：

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

to

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

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

（IT技术相关内容）

- user354134

---

我认为该功能需求可以写得更好一些。你的例子留下了很多猜测的空间。 - Sjoerd C. de Vries

是的，请更新问题，让它更具体。目前它相当模糊。 - Mr.Wizard

barrycarter，我仍在等待一个明确的问题。 - Mr.Wizard

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

- Leonid Shifrin

---

在第三个编辑中，“els：”是什么意思或作用？它是一种命名其后模式的方式吗？ - DavidC

标准的x_ 实际上是 x:_ 的简写，但前者如此常见以至于许多人不认识后者。两者都读作“命名为x且匹配 Blank[] 模式的模式”。 - Simon

@Simon 你的解释很有道理。谢谢。 - DavidC

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

- Dr. belisarius

---

直到我最后一次编辑之前，我才看到你的解决方案。我也在考虑同样的问题，但是让我花费了一些时间去解决的主要问题是如何处理基于规则的方法中子列表中任意数量的项 - 你的方法只能处理恰好两个项。 - Leonid Shifrin

@ Leonid 你是对的，但我不确定问题是否要求这种概括。 - Dr. belisarius

Answer 3

MapThread

如果“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

使用Sow和Reap可以更有效地处理不对齐的列表：

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

- WReach

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]

- 681234

---

@Simon 是的，那是最直接的方法。但这样做有什么乐趣呢？ :) - acl

@Simon。我没有看到你的代码。我在WReach发布答案时发布了这个帖子。我想删除它，但决定把它留在那里... - 681234

@TomD：我没有发布我的代码 - 因为你比我先发了。所以我投了你的答案赞成票 - 要不然我的投票就浪费了！ - Simon

@Simon 谢谢！最近点赞很少（但我正在学到很多） :-) - 681234

Answer 5

这是我使用我在“你的Mathematica工具包中有什么？”发布的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 实现此类操作更加直观。而且它基于组合 Reap 和 Sow，这在 Mathematica 中非常快。

- faysou

Answer 6

在问题更清晰，更具体之前，我假设并建议如下：

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

参见：UnsortedUnion

- Mr.Wizard

---

欢迎回来，巫师先生。度过了愉快的假期吗？你看到这个问题了吗（https://dev59.com/hWw15IYBdhLWcg3wmc8J）？我想你会喜欢它的;-) - Sjoerd C. de Vries

@Sjoerd 谢谢，是的。不，我没有。哈哈！ - Mr.Wizard

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
]

虽然 (非常) 稍微快一点，但可读性更差...

- acl