Mathematica "linked lists" and performance

Question

In Mathematica, I create singly linked lists like so:

toLinkedList[x_List] := Fold[pair[#2, #1] &, pair[], Reverse[x]];

fromLinkedList[ll_pair] := List @@ Flatten[ll];

emptyQ[pair[]] := True;
emptyQ[_pair] := False;    

Using the symbol pair for the cons cells has the advantage of Flatten working safely even if the lists contain Mathematica-style Lists, and allows you to define custom notation using MakeExpression/MakeBoxes, which makes everything much more pleasant. In order to avoid having to muck around with $IterationLimit, I wrote functions to work with these lists using either While loops or NestWhile instead of using recursion. Naturally, I wanted to see which approach would be faster, so I wrote two candidates so I could watch 'em fight:

nestLength[ll_pair] := 
 With[{step = {#[[1, -1]], #[[-1]] + 1} &},
  Last@NestWhile[step, {ll, 0}, ! emptyQ@First@# &]];

whileLength[ll_pair] := 
 Module[{result = 0, current = ll},
  While[! emptyQ@current,
   current = current[[2]];
   ++result];
  result];

The results were very strange. I tested the functions on linked lists of length 10000, and whileLength was usually about 50% faster, at about 0.035 seconds to nestLength's 0.055 seconds. However, occasionally whileLength would take about ~4 seconds. I thought there might be some caching behavior, so I started generating fresh, random lists to check, and whileLength wouldn't necessarily be slow on the first run with a new list; it might take dozens of times to see the slowdown, but then it wouldn't recur (at least not for the 200 runs I was trying with each list).

What might be going on?

For reference, the function I used for testing is this:

getTimes[f_, n_] :=
 With[{ll = toLinkedList@RandomInteger[100, 10000]},
  Table[Timing[f@ll], {n}][[All, 1]]]

EDIT: I neglected to mention the version earlier; I got these results with Mathematica 8.

EDIT the second: When I read Daniel Lichtblau's answer, I realized that my times for "typical" runs omitted a leading 0. It's been fixed.

EDIT the third: I think Leonid Shifrin is correct to associate the issue with Module; I can get the same sort of behavior from the NestWhile-based version by replacing the With with a Module:

nestModuleLength[ll_pair] := 
  Module[{step = {#[[1, -1]], #[[-1]] + 1} &}, 
   Last@NestWhile[step, {ll, 0}, ! emptyQ@First@# &]];

In[15]:= Select[getTimes[nestModuleLength, 100], # > 3 &]
Out[15]= {3.797}

Answer 1

The examples below give typical results.

One slow example in a length 20 run.

In[18]:= getTimes[whileLength, 20]

Out[18]= {0.031, 0.032, 0.031, 0.031, 0.031, 0.032, 0.031, 0.031, \
0.031, 0.047, 0.032, 0.031, 0.031, 3.547, 0.047, 0.031, 0.031, 0.032, \
0.031, 0.031}

I note in passing that the timings are ~10x faster than in the original post, except for the slow cases which are comparable. Not sure what accounts for that difference in ratios.

No slow examples.

In[17]:= getTimes[nestLength, 20]

Out[17]= {0.047, 0.047, 0.062, 0.047, 0.047, 0.062, 0.047, 0.047, \
0.047, 0.063, 0.046, 0.047, 0.047, 0.063, 0.047, 0.046, 0.047, 0.063, \
0.047, 0.047}

One slow example in a length 100 run.

In[19]:= getTimes[whileLength, 100]

Out[19]= {0.031, 0.031, 0.031, 0.032, 0.031, 3.594, 0.047, 0.031, \
0.031, 0.031, 0.032, 0.031, 0.031, 0.031, 0.032, 0.031, 0.047, 0.031, \
0.031, 0.031, 0.032, 0.031, 0.031, 0.031, 0.032, 0.047, 0.031, 0.031, \
0.031, 0.032, 0.031, 0.031, 0.031, 0.032, 0.031, 0.031, 0.047, 0.031, \
0.031, 0.032, 0.031, 0.031, 0.031, 0.032, 0.031, 0.031, 0.047, 0.031, \
0.032, 0.031, 0.031, 0.031, 0.032, 0.031, 0.031, 0.047, 0.031, 0.031, \
0.032, 0.031, 0.031, 0.031, 0.032, 0.031, 0.047, 0.031, 0.031, 0.032, \
0.031, 0.031, 0.031, 0.032, 0.031, 0.031, 0.031, 0.032, 0.046, 0.032, \
0.031, 0.031, 0.031, 0.032, 0.031, 0.031, 0.047, 0.031, 0.032, 0.031, \
0.031, 0.031, 0.032, 0.031, 0.047, 0.031, 0.031, 0.031, 0.032, 0.031, \
0.031, 0.031}

Mathematica implements, imperfectly, what is called "infinite evaluation". That is to say, an expression reevaluates until it stops changing. To make this reasonably fast there are various optimizations that attempt to short circuit the process whenever possible.

In some cases this can be tricky to discern (due to an effect similar to hash collisions), and expressions might be needlessly reevaluated. Deeply nested expressions tend to be a worst case for this. We have further code that will often address these even in cases of collisions.

The culprit in this instance is exactly this code that attempts to determine quickly whether an expression requires reevaluation. It is peculiar but possibly a clue (to someone) that this happens at most once in a run inside that While loop. So something happens in the bad cases that prevents recurrence whilst inside the same While.

At one time I was familiar with the reevaluation detection code, having written a chunk of it. But it was rewritten for version 8. So even after seeing this suboptimal behavior in a debugger, it is is something of a mystery to me. About all I can say right now is that I filed a bug report.

As Leonid Shifrin observed, symbols with Attribute of HoldAllComplete are immune to this problem. So using that attribute can be beneficial for this type of code.

Daniel Lichtblau Wolfram Research

Answer 2

A disclaimer: the following is a speculation. This seems to be related to the search for UpValues. It looks like this has been optimized for global variables (so that the system skips this step when it can determine that it can do that), but not for Module - generated local variables. To test this, assign HoldAllComplete attribute to pair, and the effect disappears (since then, UpValues are not checked for current):

SetAttributes[pair, HoldAllComplete];

In[17]:= ll = toLinkedList@RandomInteger[100, 10000];
Max[Table[Timing[whileLength[ll]], {1000}][[All, 1]]]

Out[18]= 0.047

HTH

Answer 3

Seems it's related to the Module local symbols memory management.

I'll show the timing series from some runs. Each run gives of course a unique Plot, but I checked "consistency" among runs. Look:

whileLength[l2_pair] := 
  Module[{result = 0}, current = l2; 
   While[! emptyQ@current, current = current[[2]];
    ++result];
   result];  

gives the following Timing series:

While using only Global symbols:

whileLength[l2_pair] := 
  Module[{}, result = 0; current = l2; 
   While[! emptyQ@current, current = current[[2]];
    ++result];
   result];

gives: