一，外推法确定搜索区间
程序流程图
编程思路：
假定在搜索区间[a,b]内取任意两点a1，b1，且a1 故需要编写if条件语句 程序语句： Function F(ByVal x As Single) As Double F = Val(Text1.Text) * x ^ 4 + Val(Text2.Text) * x ^ 3 + Val(Text3.Text) * x ^ 2 + Val(Text4.Text) * x + Val(Text5.Text) + Val(Text15.Text) * Sin(Val(Text14.Text) * x)'定义公共函数 End Function Private Sub Command5_Click() Dim a As Double, b As Double Dim h0 As Double, h As Double Dim y1 As Double, y2 As Double, y3 As Double Dim a1 As Double, a2 As Double, a3 As Double a = Val(Text6.Text) b = Val(Text7.Text) h0 = Val(InputBox("h0=?")) If h0 = 0 Then h0 = (b - a) / 4 End If a1 = 0: h = h0: a2 = h y1 = F(a1): y2 = F(a2) If y2 > y1 Then h = -h a3 = a1: y3 = y1 a1 = a2: y1 = y2 a2 = a3: y2 = y3 a3 = a2 + h: y3 = F(a3) Else a3 = a2 + h: y3 = F(a3) End If While y3 < y2 h = h * 2 a1 = a2: y1 = y2 a2 = a3: y2 = y3 a3 = a2 + h: y3 = F(a3) Wend Text17.Text = a1 '（新区间左端点） Text18.Text = a3 '（新区间右端点） End Sub 程序界面： 二，一维搜索试探法：黄金分割法和斐波那契法 （1）黄金分割法 程序框图 编程思路： 给出初始搜索区间[a，b]和收敛精度e； 在搜索区间内用a1，b1将[a，b]分为三段，运用while语句和if语句的嵌套完成迭代，循环主体为： a1=b-0.618（b-a）；b1=a+0.618（b-a）。当y1≥y2时将a1赋值予a，将b1赋值予a1并重新计算b1，y1，y2；当y1＜y2，将b1赋予b，a1赋予b1并重新计算a，y1，y2。 用if作为终止循环的条件。 程序语句 Private Sub Command1_Click() Dim a As Double, b As Double, eps As Double, r As Double, i As Integer, x1 As Double, y1 As Double, x2 As Double, y2 As Double, xm As Double, Fx As Double, M As Double, n As Double a = Val(Text6.Text) '搜索区间左端点 b = Val(Text7.Text) '搜索区间右端点 r = 0.618 eps = Val(Text8.Text) '在文本框4中写入的值转换为数值型赋值给精度eps x1 = a + 0.382 * (b - a) '给x1赋一个初值 y1 = F(x1) '计算这个初值所对应的函数值，以下是3-2中的例子 x2 = a + r * (b - a) '给x2赋一个初值 y2 = F(x2) '计算这个初值所对应的函数值 While Abs((b - a) / b) >= eps Or Abs(y2 - y1) / y2 >= eps i = i + 1 '当符合上述条件时进行一次循环 If y1 <= y2 Then '如果y1>=y2，那么将x1赋值给a，x2赋值给x1，y2赋值给y1 b = x2 x2 = x1 y2 = y1 x1 = a + 0.382 * (b - a) '给x1赋一个值 y1 = F(x1) '计算这个值所对应的函数值 Else '如果y1 x1 = x2 y1 = y2 x2 = a + r * (b - a) '给x2赋一个值 y2 = F(x2) '计算这个值所对应的函数值 End If Wend xm = 0.5 * (a + b) '极小值点赋值给xm x = xm y = F(xm) ym = y '计算极小值赋值给ym Label7.Caption = "搜索区间:" & Text6.Text & "到" & Text7.Text & " " & "循环次数i=" & i & " " & "极小值xm=" & xm & " " & i & "次迭代后区间的函数极值为:" & ym End Sub 程序界面： （2）斐波那契法 算法步骤： 1，确定单峰区间[a，b]，精度e； 2，确定所需计算的试点总数（即计算函数的次数）n； 3，确定试点并计算相应的函数值，在区间内的试点：x2=a+Fn-1/Fn(b-a)；x1=b-Fn-1/Fn(b-a),函数值：f1=f(x1),f2=f(x2); 4，比较f2，f1大小，当f2≥f1时新区间为[a，x2]；反之为[x1，b]； 5，终止条件丨b-a丨≤e 程序语句： Private Sub Command2_Click() Dim a As Double, b As Double, eps As Double a = Val(Text6.Text) '搜索区间左端点 b = Val(Text7.Text) '搜索区间右端点 eps = Val(Text8.Text) Dim fi As Double, fj As Double, fk As Double, i As Double, n As Double fj = 1 fk = 1 n = 2 While fk < Abs((b - a) / eps) '求斐波那契数列，确定fn和fn-1，此时fj为fn-1，fk为fn i = fk fk = fk + fj fj = i n = n + 1 Wend Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double, j As Double x1 = a + (1 - (fj / fk)) * (b - a) x2 = a + (fj / fk) * (b - a) y1 = F(x1) y2 = F(x2) While Abs(b - a) > eps '比较f2，f1大小，当f2≥f1时新区间为[a，x2]；反之为[x1，b] j = j + 1 If y2 >= y1 Then b = x2 x2 = x1 y2 = y1 x1 = a + b - x2 y1 = F(x1) Else a = x1 x1 = x2 y1 = y2 x2 = a + b - x1 y2 = F(x2) End If Wend xm = 0.5 * (a + b) '极小值点赋值给xm x = xm y = F(xm) ym = y '计算极小值赋值给ym Label9.Caption = "搜索区间:" & Text6.Text & "到" & Text7.Text & " " & "循环次数j=" & j & " " & "极小值xm=" & xm & " " & j & "次迭代后区间的函数极值为:" & ym End Sub 程序界面 三，一维搜索插值法：牛顿法和二次插值法 （1）牛顿法 牛顿迭代公式 设r是f(x) = 0的根，选取x0作为r初始近似值，过点（x0,f(x0））做曲线y = f(x）的切线L，L的方程为y = f(x0)+f'(x0)(x-x0），求出L与x轴交点的横坐标 x1 = x0-f(x0)/f'(x0），称x1为r的一次近似值。过点（x1,f(x1））做曲线y = f(x）的切线，并求该切线与x轴交点的横坐标 x2 = x1-f(x1）/f'(x1），称x2为r的二次近似值。重复以上过程，得r的近似值序列，其中x(n+1）=x(n）－f(x(n))/f'(x(n)），称为r的n+1次近似值，上式称为牛顿迭代公式。 程序语句 定义求导函数 Function G(ByVal x As Single) As Double G = Val(Text1.Text) * 4 * x ^ 3 + Val(Text2.Text) * 3 * x ^ 2 + Val(Text3.Text) * 2 * x + Val(Text4.Text) + Val(Text15.Text) * Val(Text14.Text) * Cos(Val(Text14.Text) * x) End Function 定义二次求导函数 Function M(ByVal x As Single) As Double M = Val(Text1.Text) * 4 * 3 * x ^ 2 + Val(Text2.Text) * 3 * 2 * x + Val(Text3.Text) * 2 - Val(Text15.Text) * Val(Text14.Text) * Val(Text14.Text) * Sin(Val(Text14.Text) * x) End Function 主程序： Private Sub Command3_Click() Dim a As Double, b As Double, eps As Double, k As Double eps = Val(Text10.Text) a = Val(Text9.Text) b = a - (G(a) / M(a)) Label10.Caption = "a=" & a While Abs(b - a) > eps k = k + 1 Label10.Caption = Label10.Caption & " " & b a = b b = a - G(a) / M(a) Wend Label10.Caption = Label10.Caption & " " & "迭代次数" & k & " " & "极小值a*： " & b End Sub 程序界面 （2）二次插值法 程序框图 基本思路： 二次插值的基本思想是利用目标函数在不同3点的函数值构成一个与原函数f(x)相近似的二次多项式p(x)，以函数p(x)的极值点xp(即p’(x*p)=0的根)作为目标函数f(x)的近似极值点。 程序语句： Private Sub Command4_Click() Dim a As Double, b As Double, i As Integer, x1 As Double, y1 As Double, x2 As Double, y2 As Double, x3 As Double, y3 As Double, c1 As Double, c2 As Double, xp As Double, yp As Double, xm As Double, ym As Double a = Val(Text11.Text) '搜索区间左端点 b = Val(Text12.Text) '搜索区间右端点 i = 0: h = Val(Text16.Text): eps = Val(Text13.Text) '输入步长，控制误差 x1 = a '输入左端点 y1 = F(a) '计算左端点的函数值 MsgBox ("a2是区间中点。") '输入插入点 x2 = 0.5 * (b - a) y2 = F(x2) '计算插入点的函数值 x3 = b '输入右端点 y3 = F(b) '计算右端点的函数值 c1 = (y3 - y1) / (x3 - x1) 'c1的表达式 c2 = ((y2 - y1) / (x2 - x1) - c1) / (x2 - x3) 'c2的表达式 xp = 0.5 * (x1 + x3 - c1 / c2) 'xp的表达式 yp = F(xp) '计算xp点的函数值 Do '当循环 i = i + 1 If Abs((y2 - yp) / y2) < eps Then 'if--then--的嵌套用法 If y2 < yp Then '同上 xm = x2 ym = y2 Else '同上 xm = xp ym = yp End If '同上 ElseIf (xp - x2) * h > 0 Then '同上 If y2 >= yp Then '同上 x1 = x2 y1 = y2 x2 = xp y2 = yp Else '同上 x3 = xp y3 = yp End If '同上 ElseIf y2 >= yp Then '同上 x3 = x2 y3 = y2 x2 = xp y2 = yp Else '同上 x1 = xp y1 = yp End If '结束if--then--结构 If Abs((y2 - yp) / y2) < eps Then '同上 i = i + 1 '求迭代次数 End If If Abs((y2 - yp) / y2) < eps Then Exit Do '跳出循环 Loop '结束循环 If y2 < yp Then xm = x2 ym = y2 Else xm = xp ym = yp End If Label16.Caption = "循环次数i=" & i & " " & "极小值xm=" & xm & " " & i & "次迭代后区间的函数极值为:" & ym '输出数据 End Sub 程序界面下载本文
