当功能极其复杂时，如何更快地绘制曲面？

Question

我正在尝试在以下代码中绘制函数hh的图形（请跳到代码的最后一行）。我已设置PlotPoints->2和MaxRecursion->0，但代码仍在运行，已运行约8小时。函数hh非常复杂，涉及大量迭代。有没有办法让代码运行得更快？

s0[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, x_] :=
 {a, b, u, c, d, v, p, q, z, s, t, w, 1, 0, (a + b) x + u}

s1[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, n_, x_] :=
 Which[0 <= x <= c, {a, b, u, c, d, v, p, q, z, s, t, w, 2, n - 1, x/c*q + p},
  c <= x <= c + d, {a, b, u, c, d, v, p, q, z, s, t, w, 2, n, (x - c)/d*p},
   c + d <= x <= 1, {a, b, u, c, d, v, p, q, z, s, t, w, 1, n + 1, (x - (c + d))/v*u}]

s2[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, n_, x_] :=
 Which[0 <= x <= w, {a, b, u, c, d, v, p, q, z, s, t, w, 2, n - 1, x/w*z + p + q},
  w <= x <= 1 - s, {a, b, u, c, d, v, p, q, z, s, t, w, 3, n - 1, (x - w)/t*v + c + d},
   1 - s <= x <= 1, {a, b, u, c, d, v, p, q, z, s, t, w, 3, n, (x - (1 - s))/s*d + c}]

s3[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, n_, x_] :=
 Which[0 <= x <= u, {a, b, u, c, d, v, p, q, z, s, t, w, 4, n - 1, x/u*t + w},
  u <= x <= 1 - a, {a, b, u, c, d, v, p, q, z, s, t, w, 4, n, (x - u)/b*w},
   1 - a <= x <= 1, {a, b, u, c, d, v, p, q, z, s, t, w, 3,n + 1, (x - (1 - a))/a*c}]

s4[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, n_, x_] :=
 Which[0 <= x <= p, {a, b, u, c, d, v, p, q, z, s, t, w, 4, n - 1, x/p*s + 1 - s},
  p <= x <= p + q, {a, b, u, c, d, v, p, q, z, s, t, w, 5, n - 1, (x - p)/q*a/(a+ b)+ b/(a + b)},
   p + q <= x <= 1, {a, b, u, c, d, v, p, q, z, s, t, w, 5, n, (x - (p + q))/z*b/(a + b)}]

f[{a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, k_, n_, x_}] :=
 Which[k == 0, s0[a, b, u, c, d, v, p, q, z, s, t, w, x],
  k == 1, s1[a, b, u, c, d, v, p, q, z, s, t, w, n, x],
   k == 2, s2[a, b, u, c, d, v, p, q, z, s, t, w, n, x],
    k == 3, s3[a, b, u, c, d, v, p, q, z, s, t, w, n, x],
     k == 4, s4[a, b, u, c, d, v, p, q, z, s, t, w, n, x]]

g[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, x_] := 
 NestWhile[f, {a, b, u, c, d, v, p, q, z, s, t, w, 0, 0, x}, Function[e, Extract[e, {13}] != 5]]

h[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, x_] := 
 Extract[g[a, b, u, c, d, v, p, q, z, s, t, w, x], {15}] + 
  Extract[g[a, b, u, c, d, v, p, q, z, s, t, w, x], {14}]

ff[{a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, x_}] := {a, b, u, c, d, v, p, q, z, s, t, w, h[a, b, u, c, d, v, p, q, z, s, t, w, x - Floor[x]] + Floor[x]}

gg[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_] := 
 N[Extract[Nest[ff, N[{a, b, u, c, d, v, p, q, z, s, t, w, 0}], 10^3], {13}]/10^3]

hh[x_, y_] := 
 gg[x, y, 1 - x - y, x, y, 1 - x - y, x, y, 1 - x - y, x, y, 1 - x - y]

Plot3D[hh[x, y], {x, 0, 1}, {y, 0, 1}, RegionFunction -> Function[{x, y, z}, x + y <= 1], PlotPoints -> 2,  MaxRecursion -> 0]

Answer 1

我认为您的功能存在一些问题。 不过这里有一些想法;我修改了几个函数：

s0[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, n_, x_] = 
 {a, b, u, c, d, v, p, q, z, s, t, w, 1, 0, (a + b) x + u}    

(* so it matches the others *)

f[{a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, k_, n_, x_}] := 
 {s0[a, b, u, c, d, v, p, q, z, s, t, w, n, x],                         
  s1[a, b, u, c, d, v, p, q, z, s, t, w, n, x],
  s2[a, b, u, c, d, v, p, q, z, s, t, w, n, x],
  s3[a, b, u, c, d, v, p, q, z, s, t, w, n, x],
  s4[a, b, u, c, d, v, p, q, z, s, t, w, n, x]}[[k + 1]]

 g[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, x_] := 
  NestWhile[f, {a, b, u, c, d, v, p, q, z, s, t, w, 0, 0, x}, #[[13]] != 5 &]


 h[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_, x_] := 
   Total[g[a, b, u, c, d, v, p, q, z, s, t, w, x][[{14, 15}]]]

(* in order to avoid calculating the same quantity twice *)

gg[a_, b_, u_, c_, d_, v_, p_, q_, z_, s_, t_, w_] := 
  Nest[ff, {a, b, u, c, d, v, p, q, z, s, t, w, 0}, 10^3][[13]]/10^3

{elapsed, data} = Outer[If[#1 + #2 <= 1, {#1, #2, hh[#1, #2]}, {#1, #2, "bad"}] &, 
  Range[0.1, 1, 0.25], Range[0.1, 1, 0.25]] // AbsoluteTiming

(* {6.820061, {{{0.1, 0.1, -1.99961}, {0.1, 0.35, -1.99961}, {0.1, 0.6, -2.00009}, 
   {0.1, 0.85, -2.00001}}, {{0.35, 0.1, -1.99993}, {0.35, 0.35, -2.00004}, 
   {0.35, 0.6, -2.00017}, {0.35, 0.85, "bad"}}, {{0.6, 0.1, -1.99996}, 
   {0.6,0.35, -2.00024}, {0.6, 0.6, "bad"}, {0.6, 0.85, "bad"}}, 
   {{0.85, 0.1, -1.99967}, {0.85, 0.35, "bad"}, {0.85, 0.6, "bad"}, {0.85, 0.85, "bad"}}}} *)

ListPlot3D[Select[Flatten[data, 1], NumericQ[#[[3]]] &]]