A “MapList” function

Question

In Mathematica there are a number of functions that return not only the final result or a single match, but all results. Such functions are named *List. Exhibit:

• FoldList
• NestList
• ReplaceList
• ComposeList

Something that I am missing is a MapList function.

For example, I want:

MapList[f, {1, 2, 3, 4}]

{{f[1], 2, 3, 4}, {1, f[2], 3, 4}, {1, 2, f[3], 4}, {1, 2, 3, f[4]}}

I want a list element for each application of the function:

MapList[
  f,
  {h[1, 2], {4, Sin[x]}},
  {2}
] // Column

{h[f[1], 2], {4, Sin[x]}}
{h[1, f[2]], {4, Sin[x]}}
{h[1, 2], {f[4], Sin[x]}}
{h[1, 2], {4, f[Sin[x]]}}

---

One may implement this as:

MapList[f_, expr_, level_: 1] :=
 MapAt[f, expr, #] & /@
  Position[expr, _, level, Heads -> False]

However, it is quite inefficient. Consider this simple case, and compare these timings:

a = Range@1000;
#^2 & /@ a // timeAvg
MapList[#^2 &, a] // timeAvg
ConstantArray[#^2 & /@ a, 1000] // timeAvg

0.00005088

0.01436

0.0003744

This illustrates that on average MapList is about 38X slower than the combined total of mapping the function to every element in the list and creating a 1000x1000 array.

---

Therefore, how may MapList be most efficiently implemented?

Answer 1

I suspect that MapList is nearing the performance limit for any transformation that performs structural modification. The existing target benchmarks are not really fair comparisons. The Map example is creating a simple vector of integers. The ConstantArray example is creating a simple vector of shared references to the same list. MapList shows poorly against these examples because it is creating a vector where each element is a freshly generated, unshared, data structure.

I have added two more benchmarks below. In both cases each element of the result is a packed array. The Array case generates new elements by performing Listable addition on a. The Module case generates new elements by replacing a single value in a copy of a. These results are as follows:

In[8]:= a = Range@1000;
        #^2 & /@ a // timeAvg
        MapList[#^2 &, a] // timeAvg
        ConstantArray[#^2 & /@ a, 1000] // timeAvg
        Array[a+# &, 1000] // timeAvg
        Module[{c}, Table[c = a; c[[i]] = c[[i]]^2; c, {i, 1000}]] // timeAvg

Out[9]=  0.0005504

Out[10]= 0.0966

Out[11]= 0.003624

Out[12]= 0.0156

Out[13]= 0.02308

Note how the new benchmarks perform much more like MapList and less like the Map or ConstantArray examples. This seems to show that there is not much scope for dramatically improving the performance of MapList without some deep kernel magic. We can shave a bit of time from MapList thus:

MapListWR4[f_, expr_, level_: {1}] :=
  Module[{positions, replacements}
  , positions = Position[expr, _, level, Heads -> False]
  ; replacements = # -> f[Extract[expr, #]] & /@ positions
  ; ReplacePart[expr, #] & /@ replacements
  ]

Which yields these timings:

In[15]:= a = Range@1000;
         #^2 & /@ a // timeAvg
         MapListWR4[#^2 &, a] // timeAvg
         ConstantArray[#^2 & /@ a, 1000] // timeAvg
         Array[a+# &, 1000] // timeAvg
         Module[{c}, Table[c = a; c[[i]] = c[[i]]^2; c, {i, 1000}]] // timeAvg

Out[16]= 0.0005488

Out[17]= 0.04056

Out[18]= 0.003

Out[19]= 0.015

Out[20]= 0.02372

This comes within factor 2 of the Module case and I expect that further micro-optimizations can close the gap yet more. But it is with eager anticipation that I join you awaiting an answer that shows a further tenfold improvement.

Answer 2

(Updated my function)

I think I can offer another 2x boost on top of WReach's attempt.

Remove[MapListTelefunken];
MapListTelefunken[f_, dims_] :=
 With[{a = Range[dims], fun = f[[1]]},
  With[{replace = ({#, #} -> fun) & /@ a},
   ReplacePart[ConstantArray[a, {dims}], replace]
   ]
  ]

Here are the timings on my machine (Sony Z laptop; i7, 8GB ram, 256 SSD in Raid 0):

a = Range@1000;
#^2 & /@ a; // timeAvg
MapList[#^2 &, a]; // timeAvg
MapListWR4[#^2 &, a]; // timeAvg
MapListTelefunken[#^2 &, 1000]; // timeAvg

0.0000296 (* just Mapping the function over a Range[1000] for baseline *)
0.0297 (* the original MapList proposed by Mr.Wizard *)
0.00936 (* MapListWR4 from WReach *)
0.00468 (* my attempt *)

Answer 3

I think you'd still need to create the 1000x1000 array, and I don't think there's any cleverer way than a constant array. More to the point, your examples are better served with the following definition, although I admit that it lacks the finesse of levels.

MapList[f_, list_] := (Table[MapAt[f, #, i], {i, Length@#}] &)@list;

The culprit in your own definition is the Position[] call, which creates a complex auxiliary structure.

Provide a more complex use case, that will better cover your intentions.