如何实现如下的列表操作？

Question

现有一个列表其结构如下:

生成表的代码：

f[x_, y_] := Log[x, y]
ParallelTable[
 {(Arg[f[E^(I z) x, y]] + \[Pi])/(2 \[Pi]), 1/(
   1 + 0.3 Log[Abs[f[E^(I z) x, y]] + 1]), 
   1 - 1/(1.1 + 5 Log[Abs[f[E^(I z) x, y]] + 1])], z},
 {z, -\[Pi], \[Pi], \[Pi]/5}, {y, -25 + 0.0012, 25, 1}, {x, 
  0 + 0.0012, 50, 1}]

现在我希望将这个表转化为以下的形式：

(*表的结构抽象一点来看是这样的*)
{
 {
  {{f000,z0},{f001,z0},...,{f00p,z0}},
  {{f010,z0},{f011,z0},...,{f01p,z0}},...
  {{f0q0,z0},{f0q1,z0},...,{f0qp,z0}}
 },
 {
  {{f100,z1},{f101,z1},...,{f10p,z1}},
  {{f110,z1},{f111,z1},...,{f11p,z1}},...
  {{f1q0,z1},{f1q1,z1},...,{f1qp,z1}}
 },...,
 {
  {{fr00,zr},{fr01,zr},...,{fr0p,zr}},
  {{fr10,zr},{fr11,zr},...,{fr1p,zr}},...
  {{frq0,zr},{frq1,zr},...,{frqp,zr}}
 }
}

(*现在希望变成这样*)
{
 g[{
  {{f000},{f001},...,{f00p}},
  {{f010},{f011},...,{f01p}},...
  {{f0q0},{f0q1},...,{f0qp}}
 },z0],
 g[{
  {{f100},{f101},...,{f10p}},
  {{f110},{f111},...,{f11p}},...
  {{f1q0},{f1q1},...,{f1qp}}
 },z1],...,
 g[{
  {{fr00},{fr01},...,{fr0p}},
  {{fr10},{fr11},...,{fr1p}},...
  {{frq0},{frq1},...,{frqp}}
 },zr],
}

 

Answer 1

由于题目经过修改，所以文不对题，但并无本质区别。

方法一，代码不改写，纯列表操作。

Clear[f, g]
data = Table[{f[x, y, z], 
   z}, {z, {z1, z2, z3}}, {y, {y1, y2, y3}}, {x, {x1, x2, x3}}]
g[#[[All, All, {1}]], #[[1, 1, 2]]] & /@ data

方法二，写两次Table。

Table[g[Table[{f[x, y, z]}, {y, {y1, y2, y3}}, {x, {x1, x2, x3}}], 
  z], {z, {z1, z2, z3}}]

对于第二种方法，想要并行是完全可以的，因为通常情况下z是可以不写成并行变量的，只要xy部分并行进行各个核的计算分配就足够了。

f[i_, j_, k_] := (Pause[0.1]; 
   Labeled[Framed[{100 i + 10 j + k}], $KernelID]);
ParallelTable[Table[f[i, j, k], {i, 3}, {j, 3}], {k, 3}] // 
  Dimensions // AbsoluteTiming
ParallelTable[f[i, j, k], {i, 3}, {j, 3}, {k, 3}] // 
  Dimensions // AbsoluteTiming

另外本文代码较为简单，可以通过编译进行加速，虽然效果很一般。至于实际代码能否编译，未知。

Clear[f, g]

ParallelTable[
   With[{a = Log[E^(I z) x, y]}, {(Arg[a] + \[Pi])/(2 \[Pi]), 
     1/(1 + 0.3 Log[Abs[a] + 1]), 1 - 1/(1.1 + 5 Log[Abs[a] + 1]), 
     z}], {z, -\[Pi], \[Pi], \[Pi]/10}, {y, -25 + 0.0012, 25, 1}, {x, 
    0 + 0.0012, 50, 1}] // Dimensions // AbsoluteTiming

g = Compile[{x, y, z},
   Module[{a = Log[E^(I z) x, y]},
    {(Arg[a] + \[Pi])/(2 \[Pi]), 1/(1 + 0.3 Log[Abs[a] + 1]), 
     1 - 1/(1.1 + 5 Log[a + 1]), z}],
   CompilationTarget -> "C", RuntimeOptions -> "Speed"
   ];
ParallelTable[
   g[x, y, z], {z, -\[Pi], \[Pi], \[Pi]/10}, {y, -25 + 0.0012, 25, 
    1}, {x, 0 + 0.0012, 50, 1}] // Dimensions // AbsoluteTiming

Comments

我试试。写两次Table是不能接受的，这个表到了实际要用的时候大到5百多MB，不并行一定死人的

---

就是不能两次ParallelTable我才搞那么麻烦（转圈哭）

---

一个ParallelTable+一个Table呗。

---

可以考虑把全代码贴出来，看看如何加速。

---

人家来个{z,-pi,pi,pi/0.001}，照样扑街

---

这和z到底有多少个无关啊。比如你就4个核，那么每个核按照x和y分配一下，与按照xyz分配并无差别（除非x和y只有一两个值，压根就没法分配到4个核）。

---

我在家跑的日常是{x,0,32pi,0.06},{y,-pi,pi,0.06},然后配一个恶心到死的f做函数...啊，不并行酸爽到难以置信

---

家里的6核，公家的32核...这个其实不是重点

---

对，重点并不是有几个核，重点是z并不需要并行，xy部分并行就足够了。

---

我原本的想法是将可以并行的Table一次搞出来，然后用规则匹配之类的切分list，然后送给下一级函数...这次就是搞了个参数z进去而已

---

你的想法就是我写的第一个方法呀。

---

关于并行Table已更新回答。

---

赶脚不对啊，输出的大小完全不对

---

非常对不住，我的那个输出表的函数打错了，请再看看

---

输出表的形式并无本质区别，如果你能明白我的两种解决方案的话，那么改写很容易。

---

第一种方案的原理是什么QAQ

---

啊，好像看懂了~~~~谢了