如何使用Mathematica的收集/收藏/移調功能轉換:使用Mathematica收集/收集正確
{ { {1, foo1}, {2, foo2}, {3, foo3} }, { {1, bar1}, {2, bar2}, {3, bar3} } }
到
{ {1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3} }
編輯:謝謝你!我希望有一個簡單的方法,但我猜不是!
如何使用Mathematica的收集/收藏/移調功能轉換:使用Mathematica收集/收集正確
{ { {1, foo1}, {2, foo2}, {3, foo3} }, { {1, bar1}, {2, bar2}, {3, bar3} } }
到
{ {1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3} }
編輯:謝謝你!我希望有一個簡單的方法,但我猜不是!
這裏是你的清單:
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[[email protected]@@flat]},
Map[{#}~Join~ReplaceList[#,rules]&,DeleteDuplicates[flat[[All,1]]]]]]
Out[106]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}
EDIT 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}}
也許有點過於複雜,但:
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,
{[email protected]#[[1]],
Rest[#]} &@[email protected][
Scan[(Sow[#[[1]]]; Sow[#[[2]], #[[1]]];) &,
Flatten[lst, 1]]] // Transpose
]
(很)稍快,但更不讀...
也許更容易:
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}}
*)
直到我上次編輯,我纔看到您的解決方案。我的想法與此基本相同,但我花費一些時間弄清楚的主要問題是在基於規則的方法中處理子列表中的任意數量的術語 - 您只能處理兩個術語。 –
@Leonid你是對的,但我不確定在問題 –
中是否要求這樣的概括。你是對的,它可能不是。 –
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
:
Reap[Cases[data, {x_, y_} :> Sow[y, x], {2}], _, Prepend[#2, #1] &][[2]]
我有同樣的想法,但使用聯盟,而不是你的純功能... –
也只是爲了好玩...
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]
這是我將如何使用SelectEquivalents的我張貼的版本做它在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]&)
]
這種方法是很普通的。我曾經使用過GatherBy之類的函數來處理我在Monte-Carlo模擬中生成的巨大列表。現在使用SelectEquivalents來實現這種操作更直觀。此外,它基於組合式Reap和Sow,在Mathematica中速度非常快。
歡迎回來mr.wizard。有一個很好的假期?你有沒有看到這個問題(http://stackoverflow.com/q/6505675/615464)?我想你會喜歡它;-) –
@Sjoerd謝謝,是的。不,我沒有。大聲笑! –
恕我直言,功能需求可能已經有所寫更好。你的例子有很多值得猜測的地方。 –
是的,請更新問題以獲得更具體的信息。目前它很模糊。 –
barrycarter,我還在等待一個澄清的問題。 –