Ответ 1
Кажется классической задачей для Reap
- Sow
(улучшение в финальной версии из-за @Heike):
iI[list_] := Sort[Reap[Sow @@@ list, _, List][[2]]]
Затем
iI[l]
{{a, {x}}, {b, {x}}, {c, {x, y}}, {d, {y}}, {e, {y}}, {h, {x}}}
и
In[22]:=
words=DictionaryLookup[];
abWords=DictionaryLookup["ab"~~___];
l={#,RandomChoice[abWords,RandomInteger[{1,30}]]}&/@words[[1;;3000]];
[email protected]@iI[l]
Out[25]= 0.047
ИЗМЕНИТЬ
Вот альтернативная версия с аналогичной (чуть хуже) производительностью:
iIAlt[list_] :=
[email protected][{#[[All, 1, 2]], #[[All, All, 1]]}] &@
GatherBy[Flatten[Thread /@ list, 1], Last];
Интересно, что Reap
- Sow
здесь дает еще немного более быстрое решение, чем метод, основанный на структурных операциях.
РЕДАКТИРОВАТЬ 2
Только для иллюстрации - для тех, кто предпочитает решения на основе правил, вот один из них основан на комбинации Dispatch
и ReplaceList
:
iIAlt1[list_] :=
With[{disp = [email protected][Thread[Rule[#2, #]] & @@@ list]},
Map[{#, ReplaceList[#, disp]} &, Union @@ list[[All, 2]]]]
Это примерно в 2-3 раза медленнее, чем два других.