在Mathematica中使用Newton-Raphson迭代绘制一个花脸
编写带有参数的Newton-Raphson迭代:
NewNewtonCounter = Compile[{{z, _Complex}, {r, _Real}, {otherroot, _Complex}},Module[{counter = 0, zold = N[z] + 1, znew = N[z]},If[Abs[znew] < 10^(-9), znew = 10^(-9) + 0.0 I,znew = znew];For[counter = 0,(Abs[zold - znew] > 10^(-6)) && (counter < 85), counter++,(zold = znew; znew = (r + 2*zold^3)/(-1 + r + 3*zold^2))];Which[Abs[znew - 1] < 10^(-4), counter,Abs[znew - otherroot] < 10^(-4), 85 + counter,Abs[znew - Conjugate[otherroot]] < 10^(-4), 170 + counter,True, 255]]];(*返回含参数数表:其每个值代表NR迭代次数*)
NewNewtonArray[r_, {{remin_, remax_}, {immin_, immax_}}, steps_] :=Module[{croot = -N[(1 + Sqrt[1 - 4 r])/2]},Table[NewNewtonCounter[x + y I, r, croot],{y, immin, immax, (immax - immin)/steps},{x, remin, remax, (remax - remin)/steps}]](*编写颜色函数*)
SillyFaceColor[x_] :=If[EvenQ[Floor[255*x]], RGBColor[0, 0, 0],RGBColor[1, 1, 1]]SillyFaceColorB[x_] :=Which[x < 0.333, If[EvenQ[Floor[255*x]], RGBColor[0, 0, 0],RGBColor[tr[5 (3 x)], 0, 0]],0.334 < x < 0.666, If[EvenQ[Floor[255*x]], RGBColor[0, 0, 0],RGBColor[0, 0, tr[5 (3 x - 1)]]],0.667 < x < 1, If[OddQ[Floor[255*x]], RGBColor[0, 0, 0],RGBColor[0, 0, tr[5 (3 x - 2)]]],True, RGBColor[0, 0, 0]](*绘制函数*)
FaceNewtonPlot[{{remin_, remax_}, {immin_, immax_}}, data_, colorfn_] :=ListDensityPlot[Reverse[Transpose[data]],Mesh -> False, Frame -> False,PlotRange -> {1, 255}, AspectRatio -> Automatic,ColorFunction -> colorfn]
region = NewNewtonArray[0.5, {{-2.4, -1.85}, {-0.24, 0.24}}, 2000];
FaceNewtonPlot[{{-2.4, -1.85}, {-0.24, 0.24}}, region, SillyFaceColor]
FaceNewtonPlot[{{-2.4, -1.85}, {-0.24, 0.24}}, region, SillyFaceColorB]