时间效率部分倒立索引建设

Question

我需要建立一个部分Inverted Index。例如：

l = {{x, {h, a, b, c}}, {y, {c, d, e}}} 
iI[l] 
(* 
-> {{a, {x}}, {b, {x}}, {c, {x, y}}, {d, {y}}, {e, {y}}, {h, {x}}} 
*) 

我认为它很清楚它的功能。在输入列表中，{x，y ...}是唯一的，而{a，b，c，..}不是。输出应该按照#[[1]]的顺序排列。

现在，我这样做：

iI[list_List] := {#, list[[Position[list, #][[All, 1]]]][[All, 1]]} & /@ 
        (Union@Flatten@Last@Transpose@list) 

但它看起来这样一件容易的事太令人费解，似乎太慢了，我应该能够应付军团。

试驾对比结果：

words = DictionaryLookup[]; 
abWords = DictionaryLookup["ab" ~~ ___]; 
l = {#, RandomChoice[abWords, RandomInteger[{1, 30}]]} & /@ words[[1 ;; 3000]]; 
First@Timing@iI[l] 
(* 
-> 5.312 
*) 

因此，任何想法的加速？

Answer 1

似乎是一个经典的任务Reap - （因@Heike最终版本改进）Sow：

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]]; 
First@Timing@iI[l] 
Out[25]= 0.047 

编辑

这里是另一种版本的类似（略差）性能：

iIAlt[list_] := 
    Sort@Transpose[{#[[All, 1, 2]], #[[All, All, 1]]}] &@ 
      GatherBy[Flatten[Thread /@ list, 1], Last]; 

有趣的是，Reap - Sow这里给出比基于结构化操作的一个稍微更快的解决方案。

EDIT 2

只是为了插图 - 为那些喜欢谁基于规则的解决方案，在这里是基于Dispatch和ReplaceList组合之一：

iIAlt1[list_] := 
    With[{disp = Dispatch@Flatten[Thread[Rule[#2, #]] & @@@ list]}, 
     Map[{#, ReplaceList[#, disp]} &, Union @@ list[[All, 2]]]] 

这是约2虽然比其他两个慢了3倍。