Использование 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

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

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

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

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
]

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