Использование Mathematica Соберите/Соберите правильно

Ответ 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[[email protected]@@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}}

Ответ 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}}
*)

Ответ 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:

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

Ответ 4

Вот как я сделал бы это, используя версию SelectEquivalents, которую я опубликовал в Что входит в ваш пакет инструментов Mathematica?

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, для обработки огромных списков, которые я генерирую в симуляциях Монте-Карло. Теперь реализация SelectEquivalents для таких операций намного интуитивна. Кроме того, он основан на комбинации Reap и Sow, которая очень быстро работает в Mathematica.

Ответ 5

Также просто для удовольствия...

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]

Ответ 6

Возможно, немного сложнее, но:

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 возвращает выражения, высеваемые с помощью разностных тегов в разных списках. Итак, положите их вместе и транспонируйте.

Это имеет тот недостаток, что мы сканируем дважды.

EDIT:

Это

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

(очень) немного быстрее, но еще менее читабельна...

Ответ 7

Пока вопрос не будет обновлен, чтобы быть более ясным и конкретным, я буду предполагать, что хочу, и предлагаю следующее:

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

Смотрите: UnsortedUnion