"MapList"功能

Question

在Mathematica中,有许多函数不仅返回最终结果或单个匹配,而且返回所有结果.这些功能被命名*List.展示:

• FoldList
• NestList
• ReplaceList
• ComposeList

我缺少的东西是MapList函数.

例如,我想:

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]}}

我想要一个函数的每个应用程序的列表元素:

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]]}}

---

人们可以将其实现为:

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

但是,效率很低.考虑这个简单的情况,并比较这些时间:

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

0.00005088

0.01436

0.0003744

这说明平均MapList比将函数映射到列表中的每个元素并创建1000x1000阵列的总和要慢约38倍.

---

因此,MapList如何最有效地实现？

Answer 1

我怀疑它MapList接近执行结构修改的任何转换的性能限制.现有的目标基准并不是真正公平的比较.这个Map例子是创建一个简单的整数向量.该ConstantArray示例是创建对同一列表的共享引用的简单向量. MapList这些示例显示效果不佳,因为它创建了一个向量,其中每个元素都是一个新生成的非共享数据结构.

我在下面添加了两个基准测试.在这两种情况下,结果的每个元素都是一个打包数组.该Array案例通过执行Listable加法生成新元素a.该Module案例通过替换副本中的单个值来生成新元素a.这些结果如下:

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

请注意新基准测试的表现方式MapList更像是Map或更不像ConstantArray示例.这似乎表明,MapList没有一些深层内核魔法,没有太大的空间可以显着提高性能.我们可以节省一点时间MapList:

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

这产生了这些时间:

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

这属于Module案例的第2个因素,我希望进一步的微观优化可以缩小差距.但是,我热切期待着和你一起等待一个显示进一步改善10倍的答案.

Answer 2

(更新了我的功能)

我想我可以在WReach的尝试之上提供另外2倍的提升.

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

以下是我的机器上的时间(Sony Z笔记本电脑; i7,8GB RAM,Raid 0中的256 SSD):

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