左对右链表，替换速度

Question

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

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

和"right"：

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

​

编辑来回答向导先生关于加快速度的选项的问题。一个人应该编写一个自定义的相同测试。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}