提供了编程的基础技术教程

zl程序教程

您现在的位置是：首页 >  前端

当前栏目

VBA: 最优化算法（二分法、黄金分割法、循环迭代法）的代码实现

循环算法代码 实现 最优化 vba 二分法 黄金分割
2023-06-13 09:12:58 时间

文章背景：在工程计算中，经常会遇到求解一元非线性方程的问题，如给定一个区间，求解非线性方程的根，或者求最值（最大值或最小值）。下面介绍三种比较简单的算法。

（1）二分法

（2）黄金分割法

（3）循环迭代法

（1）二分法

对于一元非线性方程f(x)=0，如果已经知道在区间[a,b]内，方程存在零点，可以采用二分法得到x的近似解。如对于f(x)=x^3+x-17，通过作图可以得出，f(x)在区间[0,6]内存在零点。

二分法的程序框图如下：

二分法的代码实现：（function） 

Option Explicit

Function Bisection(a As Double, b As Double, fxn As String) As Double

   Dim i As Integer, mid As Double, fa As Double, fmid As Double
   
   For i = 1 To 20
       
       mid = (a + b) / 2
       fa = Evaluate(Replace(fxn, "x", a))
       fmid = Evaluate(Replace(fxn, "x", mid))
       
       If fa * fmid < 0 Then
       
           b = mid
           
       Else
       
           a = mid
       
       End If
   
   Next i
   
   Bisection = FormatNumber((a + b) / 2, 2)

End Function

示例：

=Bisection(0,6,"x^3+x-17")
2.44

（2）黄金分割法

对于一元函数f(x)，如果已知在区间[a,b]内，方程存在最小值，可以采用黄金分割法得到x的近似解。如对于f(x)=x^2-6x+15，通过作图可以得出，f(x)在区间[0,6]内存在最小值。

黄金分割法的程序框图如下：

黄金分割法的代码实现：（function） 

Function GoldenSearch(a As Double, b As Double, fxn As String) As Double

   Dim i As Integer, GR As Double, d As Double
   Dim x1 As Double, x2 As Double, fx1 As Double, fx2 As Double
   
   GR = (Sqr(5) - 1) / 2
   
   For i = 1 To 20
   
       d = GR * (b - a)
       x1 = a + d
       x2 = b - d
       fx1 = Evaluate(Replace(fxn, "x", x1))
       fx2 = Evaluate(Replace(fxn, "x", x2))
       
       If fx1 < fx2 Then
       
           a = x2
           
       Else
       
           b = x1
       
       End If
   
   Next i
   
   GoldenSearch = FormatNumber((a + b) / 2, 2)

End Function

示例：

=GoldenSearch(0,6,"x^2-6*x+15")
3.00

（3）循环迭代法

对于可以转化为x=f(x)形式的一元非线性方程，有时可以采用循环迭代法，得到x的近似解。

循环迭代法求解的程序框图如下：

循环迭代法的代码实现：（function） 

Function Iteration(x As Double, fxn As String) As Double

   Dim i As Integer
   
   For i = 1 To 20
   
       x = Evaluate(Replace(fxn, "x", x))
   
   Next i
   
   Iteration = FormatNumber(x, 2)

End Function

示例：（先给定一个初值x，再进行循环迭代计算）

=Iteration(1,"1/sin(x)")
1.11

参考资料：

[1] Excel/VBA for Creative Problem Solving, Part 1（https://www.coursera.org/learn/excel-vba-for-creative-problem-solving-part-1/lecture/vvdl5/implementing-targeting-and-optimization-algorithms-in-vba-subroutines）

相关文章