删除重复列表元素,保留外观顺序

时间:2011-03-09 13:17:55

标签: wolfram-mathematica

我正在制作10 ^ 6到10 ^ 7实数的平面列表,其中一些是重复的。

我需要删除重复的实例,仅保留第一个实例,而不修改列表顺序。

这里的关键是效率,因为我有很多要处理的清单。

示例(假):

输入:

  {.8, .3 , .8, .5, .3, .6}

期望输出

  {.8, .3, .5, .6}  

除了笔记

使用Union删除重复元素(不保留顺序)会在我的穷人的笔记本电脑中显示:

DiscretePlot[a = RandomReal[10, i]; First@Timing@Union@a, {i, 10^6 Range@10}]

enter image description here

3 个答案:

答案 0 :(得分:9)

您需要DeleteDuplicates,它会保留列表顺序:

In[13]:= DeleteDuplicates[{.8, .3, .8, .5, .3, .6}]

Out[13]= {0.8, 0.3, 0.5, 0.6}

它被添加到Mathematica 7.0中。

答案 1 :(得分:9)

不要与其他答案竞争,但我无法帮助分享基于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)技术。

答案 2 :(得分:5)

对于7之前的Mathematica版本,并且出于一般兴趣,这里有几种实现UnsortedUnion(即DeleteDuplicates)函数的方法。这些是从帮助文档和MathGroup收集的。它们已被调整为接受多个列表,然后加入,类似于Union。

对于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的Mathematica 3+(?)

unsortedUnion[x_List] := Extract[x, Sort[Union[x] /. Dispatch[MapIndexed[Rule, x]]]]