Question

目前我正在使用一些Mathematica代码进行Picard迭代。代码本身工作正常，但我试图让它更有效。我取得了一些成功，但我正在寻找建议。可能无法加速它，但我已经没有想法，我希望有更多编程经验的人/ Mathematica可能会提出一些建议。我只发布迭代本身，但可以根据需要提供其他信息。

以下代码已根据要求编辑为完全可执行

此外，我将其从While循环更改为Do循环，以使测试更容易，因为不需要收敛。

Clear["Global`*"]

ngrid = 2048;
delr = 4/100;
delk = \[Pi]/delr/ngrid;
rvalues = Table[(i - 1/2) delr, {i, 1, ngrid}];
kvalues = Table[(i - 1/2) delk, {i, 1, ngrid}];
wa[x_] := (19 + .5 x) Exp[-.7 x] + 1
wb[x_] := (19 + .1 x) Exp[-.2 x] + 1
wd = SetPrecision[
   Table[{{wa[(i - 1/2) delk], 0}, {0, wb[(i - 1/2) delk]}}, {i, 1, 
     ngrid}], 26];
sigmaAA = 1;
hcloseAA = {};
i = 1;
While[(i - 1/2)*delr < sigmaAA, hcloseAA = Append[hcloseAA, -1]; i++]
hcloselenAA = Length[hcloseAA];
hcloseAB = hcloseAA;
hcloselenAB = hcloselenAA;
hcloseBB = hcloseAA;
hcloselenBB = hcloselenAA;
ccloseAA = {};
i = ngrid;
While[(i - 1/2)*delr >= sigmaAA, ccloseAA = Append[ccloseAA, 0]; i--]
ccloselenAA = Length[ccloseAA];
ccloselenAA = Length[ccloseAA];
ccloseAB = ccloseAA;
ccloselenAB = ccloselenAA;
ccloseBB = ccloseAA;
ccloselenBB = ccloselenAA;
na = 20;
nb = 20;
pa = 27/(1000 \[Pi]);
pb = 27/(1000 \[Pi]);
p = {{na pa, 0}, {0, nb pb}};
id = {{1, 0}, {0, 1}};
AFD = 1;
AFDList = {};
timelist = {};
gammainitial = Table[{{0, 0}, {0, 0}}, {ngrid}];
gammafirst = gammainitial;
step = 1;
tol = 10^-7;
old = 95/100;
new = 1 - old;

Do[
 t = AbsoluteTime[];
 extractgAA = Table[Extract[gammafirst, {i, 1, 1}], {i, hcloselenAA}];
 extractgBB = Table[Extract[gammafirst, {i, 2, 2}], {i, hcloselenBB}];
 extractgAB = Table[Extract[gammafirst, {i, 1, 2}], {i, hcloselenAB}];
 csolutionAA = (Join[hcloseAA - extractgAA, ccloseAA]) rvalues;
 csolutionBB = (Join[hcloseBB - extractgBB, ccloseBB]) rvalues;
 csolutionAB = (Join[hcloseAB - extractgAB, ccloseAB]) rvalues;
 chatAA = FourierDST[SetPrecision[csolutionAA, 32], 4];
 chatBB = FourierDST[SetPrecision[csolutionBB, 32], 4];
 chatAB = FourierDST[SetPrecision[csolutionAB, 32], 4];
 chatmatrix = 
  2 \[Pi] delr Sqrt[2*ngrid]*
   Transpose[{Transpose[{chatAA, chatAB}], 
      Transpose[{chatAB, chatBB}]}]/kvalues;
 gammahat = 
  Table[(wd[[i]].chatmatrix[[i]].(Inverse[
         id - p.wd[[i]].chatmatrix[[i]]]).wd[[i]] - 
      chatmatrix[[i]]) kvalues[[i]], {i, ngrid}];
 gammaAA = 
  FourierDST[SetPrecision[Table[gammahat[[i, 1, 1]], {i, ngrid}], 32],
    4];
 gammaBB = 
  FourierDST[SetPrecision[Table[gammahat[[i, 2, 2]], {i, ngrid}], 32],
    4];
 gammaAB = 
  FourierDST[SetPrecision[Table[gammahat[[i, 1, 2]], {i, ngrid}], 32],
    4];
 gammasecond = 
  Transpose[{Transpose[{gammaAA, gammaAB}], 
     Transpose[{gammaAB, gammaBB}]}]/(rvalues 2 \[Pi] delr Sqrt[
      2*ngrid]);
 AFD = Sqrt[
    1/ngrid Sum[((gammafirst[[i, 1, 1]] - 
           gammasecond[[i, 1, 1]])/(gammafirst[[i, 1, 1]] + 
           gammasecond[[i, 1, 1]]))^2 + ((gammafirst[[i, 2, 2]] - 
           gammasecond[[i, 2, 2]])/(gammafirst[[i, 2, 2]] + 
           gammasecond[[i, 2, 2]]))^2 + ((gammafirst[[i, 1, 2]] - 
           gammasecond[[i, 1, 2]])/(gammafirst[[i, 1, 2]] + 
           gammasecond[[i, 1, 2]]))^2 + ((gammafirst[[i, 2, 1]] - 
           gammasecond[[i, 2, 1]])/(gammafirst[[i, 2, 1]] + 
           gammasecond[[i, 2, 1]]))^2, {i, 1, ngrid}]];
 gammafirst = old gammafirst + new gammasecond;
 time2 = AbsoluteTime[] - t;
 timelist = Append[timelist, time2], {1}]
Print["Mean time per calculation = ", Mean[timelist]]
Print["STD time per calculation = ", StandardDeviation[timelist]]

关于事物的一些注释 ngrid，delr，delk，rvalues，kvalues只是用于使问题离散的值。通常他们是

ngrid = 2048;
delr = 4/100;
delk = \[Pi]/delr/ngrid;
rvalues = Table[(i - 1/2) delr, {i, 1, ngrid}];
kvalues = Table[(i - 1/2) delk, {i, 1, ngrid}];

所有使用的矩阵都是2 x 2，具有相同的非对角线

单位矩阵和P矩阵（实际上是密度）是

p = {{na pa, 0}, {0, nb pb}};
id = {{1, 0}, {0, 1}};

我已经确定的计算中的主要慢点是FourierDST计算（前向和后向变换占计算时间的近40％）伽玛计算占40％的时间。剩余时间由AFD计算主导。）在我的i7处理器上，每个周期的平均计算时间为1.52秒。我希望能在一秒钟内完成它，但这可能是不可能的。我希望引入一些并行计算，尝试使用ParallelTable命令以及使用ParallelSubmit WaitAll。但是，我发现并行计算的任何加速都被从主内核到其他内核的通信时间所抵消。（至少这是我的假设，因为对新数据的计算需要两倍于重新计算现有数据的时间。我认为这意味着减速正在传播新的列表）我使用DistributDefinitions以及SetSharedVariable来玩，但是，无法做到这一点。

我想知道的一件事是，使用Table进行离散计算是最好的方法吗？

我还以为我可能会以这样的方式重写它，以便能够编译它，但我的理解是，只有在处理机器精度时才能工作，我需要以更高的精度工作以获得收敛。

提前感谢您的任何建议。

Answer 1

我将等待acl建议的代码，但是在顶部，我怀疑这个构造：

Table[Extract[gammafirst, {i, 1, 1}], {i, hcloselenAA}]

可以编写，并且执行速度更快，如下：

gammafirst[[hcloselenAA, 1, 1]]

但我不得不猜测你数据的形状。

Answer 2

使用以下几行：

FourierDST[SetPrecision[Table[gammahat[[i, 1, 1]], {i, ngrid}], 32], 4];

您可以删除Table：

FourierDST[SetPrecision[gammahat[[All, 1, 1]], 32], 4];

而且，如果你确实需要这个SetPrecision，那么在计算gammahat时你不能立刻这样做吗？

AFAI可以看到，gammahat计算中使用的所有数字都是准确的。这可能是故意的，但速度很慢。您可以考虑使用近似数字。

修改
使用最新编辑中的完整代码，只需在第2行和第3行添加//N即可将时间减少至少一半而不会降低数值精度。如果我比较res = {gammafirst，gammasecond，AFD}中的所有数字，原始和添加的// N之间的差异是res1 - res2 // Flatten // Total ==＆gt; 1.88267 * 10 ^ -13

删除所有SetPrecision内容会使代码速度提高7倍，结果似乎具有相似的准确度。

使用Picard迭代中的矩阵列表优化计算

2 个答案: