Wolfram mathematica 高效时间的部分倒排索引构建

Wolfram mathematica 高效时间的部分倒排索引构建,wolfram-mathematica,Wolfram Mathematica,我需要建立一个局部模型。比如: 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

我需要建立一个局部模型。比如:

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
*)

那么,有什么加速的想法吗?

似乎是
eaw
-
Sow
的经典任务(由于@Heike,最终版本有所改进):

那么

编辑

以下是一个性能类似(稍差)的替代版本:

iIAlt[list_] :=
   Sort@Transpose[{#[[All, 1, 2]], #[[All, All, 1]]}] &@
           GatherBy[Flatten[Thread /@ list, 1], Last];
有趣的是,
eaw
-
Sow
这里给出的解决方案比基于结构操作的解决方案更快

编辑2

仅举一个例子-对于那些喜欢基于规则的解决方案的人,这里有一个基于
Dispatch
ReplaceList
组合的解决方案:

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

不过,它的速度大约是另外两个的2-3倍。

确实不错<代码>线程-甚至不需要编辑列表;你可以做一些像
iI[list.]:=Sort[reaw[Sow@@@list,[u,list][[2]]]]
这样的事情来加快速度。@Heike,谢谢。当我在开发代码时,不知何故,我首先想到的应该是
Sow[#2,#1]&
,如果是真的,则需要
线程
。当我意识到订购是直接的,我忘了删除它。将进行编辑以使用您的版本。@belisarius迫不及待:)。我不应该让你一个人呆在那个可怕的地方:)我添加了另一个版本。b、 t.w.@belisarius事实上,通向荣耀的两个步骤:)一个答案是工具包。如果Leonid继续删除他的答案,只会花更长的时间;)
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];
iIAlt1[list_] :=
   With[{disp = Dispatch@Flatten[Thread[Rule[#2, #]] & @@@ list]},
       Map[{#, ReplaceList[#, disp]} &, Union @@ list[[All, 2]]]]