Mathematica большая таблица периодической интерполяции

Question

У меня есть очень большая таблица в Mathematica ((dimcub-1) ^ 3 элемента) из обратного БПФ. Мне нужно использовать периодическую интерполяцию на этой таблице. Поскольку периодическая интерполяция требует, чтобы первые элементы и последние элементы были равны, я вручную создаю новую таблицу из dim ^ 3 элементов и использую ее в своей интерполяции. Это работает, но это уродливо / медленно, и из-за моей избыточной промежуточной таблицы я быстрее преодолеваю барьер памяти. Может ли кто-нибудь сказать мне, как каким-то образом превратить мою старую таблицу в периодическую, добавляя элементы, или использовать мою непериодическую таблицу для создания функции периодической интерполяции? Вот мой текущий кусок кода:

mr 1 - новая таблица:

mr1 = Table[  0. , {i, 1, dimcub}, {j, 1, dimcub}, {k, 1, dimcub}];

Do[Do[  Do[   
      mr1[[m, n, k]] = oldtable[[m, n, k]] ;  , {m, 1, 
       dimcub - 1}]; , {n, 1, dimcub - 1}]; , {k, 1, dimcub - 1}]; 
Do[Do[     mr1[[m, n, dimcub]] =  mr1[[m, n, 1]]; 
  mr1[[m, dimcub, n]] =  mr1[[m, 1, n]];  
  mr1[[dimcub, m, n]] =  mr1[[1, m, n]];     , {m, 1, dimcub - 1}];  
 mr1[[n, dimcub, dimcub]] =  mr1[[n, 1, 1]]; 
 mr1[[dimcub, n, dimcub]] =  mr1[[1, n, 1]];  
 mr1[[dimcub, dimcub, n]] =  mr1[[1, 1, n]]; , {n, 1, dimcub - 1}]; 
mr1[[dimcub, dimcub, dimcub]] = mr1[[1, 1, 1]]; 

Remove[oldtable]; 

myinterpolatingfunction = 
 ListInterpolation[mr1, {{1, dimcub}, {1, dimcub}, {1, dimcub}}, 
  InterpolationOrder -> 1, 
  PeriodicInterpolation -> True];

 Remove[mr1];

myinterpolatingfunction занимает намного меньше памяти и работает отлично, как только я удаляю старые таблицы. Любая помощь будет принята с благодарностью.

Answer 1

Ответы как Леонида, так и мистера Волшебника делают слишком много работы. В случае Леонида нужны только первые три строки. Чтобы показать это, я изменю последние 4 Set с на Equal с:

In[65]:= len = 4; oldtable = 
 Partition[Partition[Range[len^3], len], len]

Out[65]= {{{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 
   16}}, {{17, 18, 19, 20}, {21, 22, 23, 24}, {25, 26, 27, 28}, {29, 
   30, 31, 32}}, {{33, 34, 35, 36}, {37, 38, 39, 40}, {41, 42, 43, 
   44}, {45, 46, 47, 48}}, {{49, 50, 51, 52}, {53, 54, 55, 56}, {57, 
   58, 59, 60}, {61, 62, 63, 64}}}

In[66]:= oldtable[[All, All, -1]] = oldtable[[All, All, 1]];
oldtable[[All, -1, All]] = oldtable[[All, 1, All]];
oldtable[[-1, All, All]] = oldtable[[1, All, All]];
oldtable[[All, -1, -1]] == oldtable[[All, 1, 1]]
oldtable[[-1, All, -1]] == oldtable[[1, All, 1]]
oldtable[[-1, -1, All]] == oldtable[[1, 1, All]]
oldtable[[-1, -1, -1]] == oldtable[[1, 1, 1]]

Out[69]= True

Out[70]= True

Out[71]= True

Out[72]= True

То, что делает Леонид, показано на рисунках ниже. Строки 4-6 его кода делают что-то, как показано на левой панели: копирование линии (более темный цвет) уже скопированной плоскости (светлые цвета). Линия 7 иллюстрируется правой панелью. Это копия от ячейки к ячейке противоположных по диагонали позиций, и ее действие не включено отдельно ни в одно из первых трех действий копирования, но является результатом их последовательной операции.

Answer 2

Вы можете получить его намного быстрее и эффективнее с памятью, изменив исходную таблицу следующим образом:

oldtable[[All, All, -1]] = oldtable[[All, All, 1]];
oldtable[[All, -1, All]] = oldtable[[All, 1, All]];
oldtable[[-1, All, All]] = oldtable[[1, All, All]];
oldtable[[All, -1, -1]] = oldtable[[All, 1, 1]];
oldtable[[-1, All, -1]] = oldtable[[1, All, 1]];
oldtable[[-1, -1, All]] = oldtable[[1, 1, All]];
oldtable[[-1, -1, -1]] = oldtable[[1, 1, 1]];

Эти назначения заменяют вложенные циклы и выполняются намного быстрее, плюс вам не требуется память для хранения копии. Это основано на расширенной векторизованной функциональности команды Part (индексирование массивов и общих выражений), особенно векторизованных назначениях. Также важно иметь числовой массив в форме Packed array , что часто имеет место.

Answer 3

Только потому, что я немного сумасшедший, решение Леонида можно записать так:

a = {0, 1}~Tuples~3~SortBy~Tr // Rest;

MapThread[
  (oldtable[[Sequence @@ #]] = oldtable[[Sequence @@ #2]]) &,
  {-a, a} /. 0 -> All
];

Answer 4

Спасибо за все ответы. Я попробовал это предложение от Леонида, но когда я напечатал свой старый файл, он все еще был (dimcub -1) ^ 3-мерный. Новые элементы были определены, и я вижу их по отдельности, но они не отображаются как часть старой таблицы, когда я печатаю всю таблицу. В итоге я получил нечто подобное, которое делает именно то, что мне нужно:

oldtable= PadRight[oldtable, {dimcub, dimcub, dimcub}];
oldtable[[All, All, dimcub]] = oldtable[[All, All, 1]];
oldtable[[All, dimcub, All]] = oldtable[[All, 1, All]];
oldtable[[dimcub, All, All]] = oldtable[[1, All, All]];
oldtable[[All, dimcub, dimcub]] = oldtable[[All, 1, 1]];
oldtable[[dimcub, All, dimcub]] = oldtable[[1, All, 1]];
oldtable[[dimcub, dimcub, All]] = oldtable[[1, 1, All]];
oldtable[[dimcub, dimcub, dimcub]] = oldtable[[1, 1, 1]];

Ответ Wizard слишком сложен для моего уровня математики ..