用Mathematica实现牛顿拉斐森算法

• 使用NSolve方法解出函数根

  F[x_] = 8 x^5 - 3 x^4 + 2 x^3 + 9 x - 5;
  DF[x_] = D[F[x], x];
  RootsF = NSolve[F[x] == 0, x]

• 画出函数图形

  PlotF = Plot[F[x], {x, -3, 7}, PlotStyle -> {Blue, Thickness[0.007]}];
  Show[PlotF, PlotRange -> {{-3, 7}, {-1000, 1000}}]

• 画图形象展示牛顿算法的求根原理。此处展示为如何求解实数根。（因为坐纵坐标范围过大，箭头纵坐标差值给的适当大些才能显示箭头尾部）

首先我们确定一个与实数较近的点，此处选取1，由公式xi+1=xi-f(x)/f’(x)求解出x1，并且切线公式为y=（DF[xi]）x+F[xi]-xi*DF[xi]。

x0 = SetPrecision[1, 10];
x1 = (x0 - F[x0]/DF[x0])
F[x0]
DF[x0]
F[x0] - x0 DF[x0]
F[x1]
DF[x1]
F[x1] - x1 DF[x1]
ArrowPlots = 
 Graphics[{Arrowheads[.05], Thickness[.010], Yellow, 
   Arrow[{{1, -25}, {1, -4.5}}],(*前一个坐标箭头尾巴，后一个坐标箭头脑袋*)Black, 
   Arrow[{{0.7441, -25}, {0.7441, -4.5}}], Red, 
   Arrow[{{0.516, 30}, {0.516, 2}}]}]; TangentF = 
 Plot[43 x - 32, {x, -1, 3}, PlotStyle -> {Black, Thickness[0.007]}];
Show[ArrowPlots, PlotF, TangentF, PlotRange -> {{-1, 3}, {-40, 100}}, 
 Axes -> True, AspectRatio -> 2/3]

      求出数据后，进行图形的绘制，黑线表示切线，黑色箭头表示切线与横轴交点，以此作为下一次逼近的依据点。

      再进行一次迭代，此时蓝色箭头指向红色切线与横轴交点，以此作为下一次逼近的依据点，我们可以看出，蓝色箭头和红色箭头已经距离很近。

• 利用循环进行八次迭代，观察结果，此时已经和NSolve的结果很相近。

  
  x[0] = N[0, 30];
  For[k = 1, k <= 8, k++, x[k] = (x[k - 1] - F[x[k - 1]]/DF[x[k - 1]]);]
  Table[{"x", k, "=", N[x[k], 12]}, {k, 1, 8}] // MatrixForm

• 通过牛顿算法分别从-1+i，-1-i，0.5,1+i，1-i开始对方程的根进行十次迭代，由结果可以看出，根的值逐渐接近NSlove求出的结果。

  x[0] = N[{-1 + I, -1 - I, 0.5, 1 + I, 1 - I}, 30];
  Newt[x_] = x - F[x]/DF[x]
  N[NestList[Newt[#] &, x[0], 10], 12] // MatrixForm