Left vs Right linked list, Replace speed

Question

There are two obvious ways to structure a linked list in Mathematica, "left":

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

And "right":

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

These can be made with:

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

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

If I use these, and do a simple ReplaceRepeated to walk through the linked list, I get drastically different Timing results:

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} *)

Why?

Answer 1

ReplaceRepeated uses SameQ to determine when to stop applying the rule.

When SameQ compares two lists, it checks lengths, and if the same, then applies SameQ to elements from the first to the last. In the case of left the first element is an integer, so it is easy to detect distinct lists, while for right list the first element is the deeply nested expression, so it needs to traverse it. This is the reason for the slowness.

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

Out[25]= {11.7091708, Null}

Now compare this with:

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}