左对右链表,替换速度

Question

在Mathematica中有两种明显的方法来构建链表,"左":

{1, {2, {3, {4, {5, {6, {7, {}}}}}}}}

并且"正确":

{{{{{{{{}, 7}, 6}, 5}, 4}, 3}, 2}, 1}

这些可以用:

toLeftLL = Fold[{#2, #} &, {}, Reverse@#] & ;

toRightLL = Fold[List, {}, Reverse@#] & ;

如果我使用这些,并简单ReplaceRepeated地浏览链表,我会得到截然不同的Timing结果:

r = Range[15000];
left = toLeftLL@r;
right = toRightLL@r;

Timing[i = 0; left //. {head_, tail_} :> (i++; tail); i]
Timing[i = 0; right //. {tail_, head_} :> (i++; tail); i]

(* Out[6]= {0.016, 15000} *)

(* Out[7]= {5.437, 15000} *)

为什么？

Answer 1

ReplaceRepeated用于SameQ确定何时停止应用规则.

当SameQ两个列表进行比较,它会检查长度,如果相同,则适用SameQ于从第一到最后一个元素.在left第一个元素是整数的情况下,因此很容易检测不同的列表,而对于right列表,第一个元素是深度嵌套的表达式,因此需要遍历它.这就是缓慢的原因.

In[25]:= AbsoluteTiming[
 Do[Extract[right, ConstantArray[1, k]] === 
   Extract[right, ConstantArray[1, k + 1]], {k, 0, 15000 - 1}]]

Out[25]= {11.7091708, Null}

现在比较一下:

In[31]:= Timing[i = 0; right //. {tail_, head_} :> (i++; tail); i]

Out[31]= {5.351, 15000}

编辑回应Mr.Wizard关于加快这个问题的选择问题.人们应该写一个自定义相同的测试.ReplaceRepeated不提供这样的选择,所以我们应该使用FixedPoint和ReplaceAll:

In[61]:= Timing[i = 0; 
 FixedPoint[(# /. {tail_, _} :> (i++; tail)) &, right, 
  SameTest -> 
   Function[
    If[ListQ[#1] && ListQ[#2] && 
      Length[#1] == 
       Length[#2], (#1 === {} && #2 === {}) || (Last[#1] === 
        Last[#2]), #1 === #2]]]; i]

Out[61]= {0.343, 15000}

EDIT2:更快:

In[162]:= Timing[i = 0; 
 NestWhile[Function[# /. {tail_, head_} :> (i++; tail)], right, 
  Function[# =!= {}]]; i]

Out[162]= {0.124, 15000}