Функция "MapList"

Question

В Mathematica существует ряд функций, которые возвращают не только конечный результат или одно совпадение, но и все результаты.Такие функции называются *List.Приложение:

• FoldList
• NestList
• ReplaceList
• ComposeList

То, что мне не хватает, это MapListfunction.

Например, я хочу:

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 примерно в 38 раз медленнее, чем суммарный итог отображения функции на каждый элемент всоставить список и создать массив 1000x1000.

---

Следовательно, как наиболее эффективно реализовать 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

Это соответствует фактору 2 случая Module, и я ожидаючто дальнейшая микрооптимизация может еще больше сократить разрыв.Но я с нетерпением жду, что я присоединюсь к вам в ожидании ответа, который покажет дальнейшее десятикратное улучшение.

Answer 2

( Обновил мою функцию )

Я думаю, что могу предложить еще 2-кратное повышение в дополнение к попытке WReach.

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

Вот время на моей машине (ноутбук Sony Z; i7, 8 ГБ оперативной памяти, 256 SSD в 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

Я думаю, вам все еще нужно создать массив 1000x1000, и я не думаю, что есть какой-то более умный способ, чем постоянный массив. Более того, ваши примеры лучше подаются со следующим определением, хотя я допускаю, что в нем не хватает изящества уровней.

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

Виновником в вашем собственном определении является вызов Position[], который создает сложную вспомогательную структуру.

Укажите более сложный вариант использования, который лучше соответствует вашим намерениям.