Левый и правый связанные списки, Заменить скорость

Есть два очевидных способа структурирования связанного списка в Mathematica, "left":

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

И "right":

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

Они могут быть сделаны с помощью

toLeftLL = Fold[{#2, #} &, {}, [email protected]#] & ;

toRightLL = Fold[List, {}, [email protected]#] & ;

Если я использую их и пробую ReplaceRepeated, чтобы пройти через связанный список, я получаю радикально разные результаты Timing:

r = Range[15000];
left = [email protected];
right = [email protected];

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

Почему?

Ответ 1

ReplaceRepeated использует SameQ, чтобы определить, когда прекратить применение правила.

Когда SameQ сравнивает два списка, он проверяет длины и, если это то же самое, тогда применяется SameQ к элементам от первого до последнего. В случае left первый элемент представляет собой целое число, поэтому легко обнаружить разные списки, тогда как для right list первый элемент является глубоко вложенным выражением, поэтому ему необходимо пройти его. Это причина медленности.

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}

РЕДАКТИРОВАТЬ В ответ на вопрос Mr.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}