删除保留外观顺序的重复列表元素
我正在制作10 ^ 6到10 ^ 7实数的单子列表,其中一些正在重复。
我需要删除重复的实例,只保留第一次出现,并且不修改列表顺序。
这里的关键是效率,因为我有很多名单要处理。
示例(假):
输入:
{.8, .3 , .8, .5, .3, .6}
期望的输出
{.8, .3, .5, .6}
另外注意
联盟删除重复元素(不保留顺序)给我的穷人的笔记本电脑:
DiscretePlot[a = RandomReal[10, i]; First@Timing@Union@a, {i, 10^6 Range@10}]
你想要DeleteDuplicates
,它保留列表顺序:
In[13]:= DeleteDuplicates[{.8, .3, .8, .5, .3, .6}]
Out[13]= {0.8, 0.3, 0.5, 0.6}
它被添加到Mathematica 7.0中。
不要与其他答案竞争,但我无法分享基于Compile
的解决方案。 该解决方案基于构建二叉搜索树,然后检查列表中的每个数字,列表中的索引是否是构建B树时使用的索引。 如果是,那么它是原始号码,如果不是 - 它是重复的。 这个解决方案对我来说很有意思的是,它展示了一种用Compile
模拟“通过引用传递”的方法。 关键在于,如果我们将编译函数内联到其他编译函数中(并且可以通过“InlineCompiledFunctions”选项实现),我们可以在内函数中引用外函数范围中定义的变量(因为内联函数的方式) 。 这不是一个真正的通过引用,但它仍然允许从小块组合函数,而没有效率惩罚(这更符合宏观扩展的精神)。 我不认为这是记录,并不知道这是否会留在未来的版本。 无论如何,这里是代码:
(* A function to build a binary tree *)
Block[{leftchildren , rightchildren},
makeBSearchTree =
Compile[{{lst, _Real, 1}},
Module[{len = Length[lst], ctr = 1, currentRoot = 1},
leftchildren = rightchildren = Table[0, {Length[lst]}];
For[ctr = 1, ctr <= len, ctr++,
For[currentRoot = 1, lst[[ctr]] != lst[[currentRoot]],(*
nothing *),
If[lst[[ctr]] < lst[[currentRoot]],
If[leftchildren[[currentRoot]] == 0,
leftchildren[[currentRoot]] = ctr;
Break[],
(* else *)
currentRoot = leftchildren[[currentRoot]] ],
(* else *)
If[rightchildren[[currentRoot]] == 0,
rightchildren[[currentRoot]] = ctr;
Break[],
(* else *)
currentRoot = rightchildren[[currentRoot]]]]]];
], {{leftchildren, _Integer, 1}, {rightchildren, _Integer, 1}},
CompilationTarget -> "C", "RuntimeOptions" -> "Speed",
CompilationOptions -> {"ExpressionOptimization" -> True}]];
(* A function to query the binary tree and check for a duplicate *)
Block[{leftchildren , rightchildren, lst},
isDuplicate =
Compile[{{index, _Integer}},
Module[{currentRoot = 1, result = True},
While[True,
Which[
lst[[index]] == lst[[currentRoot]],
result = index != currentRoot;
Break[],
lst[[index]] < lst[[currentRoot]],
currentRoot = leftchildren[[currentRoot]],
True,
currentRoot = rightchildren[[currentRoot]]
]];
result
],
{{leftchildren, _Integer, 1}, {rightchildren, _Integer,
1}, {lst, _Real, 1}},
CompilationTarget -> "C", "RuntimeOptions" -> "Speed",
CompilationOptions -> {"ExpressionOptimization" -> True}
]];
(* The main function *)
Clear[deldup];
deldup =
Compile[{{lst, _Real, 1}},
Module[{len = Length[lst], leftchildren , rightchildren ,
nodup = Table[0., {Length[lst]}], ndctr = 0, ctr = 1},
makeBSearchTree[lst];
For[ctr = 1, ctr <= len, ctr++,
If[! isDuplicate [ctr],
++ndctr;
nodup[[ndctr]] = lst[[ctr]]
]];
Take[nodup, ndctr]], CompilationTarget -> "C",
"RuntimeOptions" -> "Speed",
CompilationOptions -> {"ExpressionOptimization" -> True,
"InlineCompiledFunctions" -> True,
"InlineExternalDefinitions" -> True}];
以下是一些测试:
In[61]:= intTst = N@RandomInteger[{0,500000},1000000];
In[62]:= (res1 = deldup[intTst ])//Short//Timing
Out[62]= {1.141,{260172.,421188.,487754.,259397.,<<432546>>,154340.,295707.,197588.,119996.}}
In[63]:= (res2 = Tally[intTst,Equal][[All,1]])//Short//Timing
Out[63]= {0.64,{260172.,421188.,487754.,259397.,<<432546>>,154340.,295707.,197588.,119996.}}
In[64]:= res1==res2
Out[64]= True
不像Tally
版本那么快,但也是基于Equal
的,正如我所说的,我的观点是说明一个有趣的(IMO)技术。
对于7之前的Mathematica版本,为了大家的兴趣,下面介绍几种实现UnsortedUnion(即DeleteDuplicates)函数的方法。 这些是从帮助文档和MathGroup收集的。 他们已被调整为接受多个名单,然后加入,类似于联盟。
对于Mathematica 4或更早的版本
UnsortedUnion = Module[{f}, f[y_] := (f[y] = Sequence[]; y); f /@ Join@##] &
对于Mathematica 5
UnsortedUnion[x__List] := Reap[Sow[1, Join@x], _, # &][[2]]
对于Mathematica 6
UnsortedUnion[x__List] := Tally[Join@x][[All, 1]]
来自Leonid Shifrin for Mathematica 3+(?)
unsortedUnion[x_List] := Extract[x, Sort[Union[x] /. Dispatch[MapIndexed[Rule, x]]]]
链接地址: http://www.djcxy.com/p/35509.html
上一篇: Delete repeating list elements preserving order of appearance
下一篇: Setting up diagnostic error messages in large Mathematica projects