左链表与右链表，替换速度

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}

---

EDIT In response to Mr.Wizard's question of options to speed this up. One should write a custom same testings. ReplaceRepeated does not provide such an option, so we should use FixedPoint and 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: Faster yet:

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

Out[162]= {0.124, 15000}