izquierda versus lista de Derecho vinculado, Reemplazar velocidad

Question

Hay dos maneras obvias para estructurar una lista enlazada en Mathematica, "izquierda":

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

y "derecha":

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

Estos se pueden hecha con:

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

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

Si utilizo estos, y hago un simple ReplaceRepeated a caminar a través de la lista enlazada, que recibo drasti camente diferentes Timing resultados:

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

¿Por qué?

Answer 1

ReplaceRepeated usa SameQ para determinar cuándo dejar de aplicar la regla.

Cuando SameQ compara dos listas, comprueba las longitudes, y si es igual, aplica SameQ a los elementos del primero al último. En el caso de left, el primer elemento es un número entero, por lo que es fácil detectar listas distintas, mientras que para el right lista el primer elemento es la expresión profundamente anidada, por lo que debe atravesarla. Esta es la razón de la lentitud.

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

Out[25]= {11.7091708, Null} 

Ahora compare esto con:

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

Out[31]= {5.351, 15000} 

---

EDITAR En respuesta a la pregunta de opciones de Mr.Wizard a acelerar este proceso. Uno debe escribir una misma prueba personalizada. ReplaceRepeated no ofrece esa opción, por lo que debemos utilizar FixedPoint y 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: Más rápido aún:

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

Out[162]= {0.124, 15000}