左链表vs右链表，取代速度

Question

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

{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}

---

编辑回答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}