节省时间的部分倒排索引构建

Question

我需要构建部分倒排索引。比如：

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-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]];
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 提供了比基于结构操作的解决方案稍快的解决方案。

编辑 2

只是为了说明 - 对于那些喜欢基于规则的解决方案的人，这里是一个基于 Dispatch 和 ReplaceList 组合的解决方案

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

：不过，比其他两个慢大约2-3倍。