题目利用二分法,计算下列函数在[a,b]范围的实根,程序计算后的结果如图1所示.OptionBase1PrivateFunctionfun1(xAsSingle)AsSinglefun1=x*x*x-3*x*x-2*x+1EndSubPrivateFunctionroot(aAsSingle,bAs

Question

【题目】利用二分法,计算下列函数在[a,b]范围的实根,程序计算后的结果如图1所示.
Option Base 1
Private Function fun1(x As Single) As Single
fun1 = x * x * x - 3 * x * x - 2 * x + 1
End Sub
Private Function root(a As Single,b As Single) As Single
Dim rot As Single
f0 = fun1(a)
rot = (a + b) / 2
For Abs(a - rot) > 0.000001 Then
If f0 * fun1(rot) > 0 Then
root = root(rot,b)
Else
root = root(a,rot)
End If
Else
root = rot
End If
End Function
Private Sub Command1_Click()
Dim x As Single,a As Single,b As Single
a = Val(Text1(0).Text)
b = Val(Text1(1).Text)
f0 = fun1(a)
f1 = fun1(b)
If f0 * f1 = 0 Then
MsgBox "此区间方程无解!"
Else
rot = root(a,b)
End If
Text1(2).Text = rot
End Sub

Answer 1

0.3433796,-0.8342433,3.490864
'每次只找其中的一个
Option Base 1
Const wucha As Double = 0.000001
Private Function fun1(x As Single) As Single
fun1 = x * x * x - 3 * x * x - 2 * x + 1
End Function
Private Function root(a As Single,b As Single)
Dim rot As Single
f0 = fun1(a)
f1 = fun1(b)
If Abs(f0) < wucha Then
root = a 'a是解
ElseIf Abs(f1) < wucha Then 'b是解
'If Len(rot) Then rot = rot & "," & f1 Else rot = f1
root = b
ElseIf f0 * f1 > 0 Then '同号,有0个或2个解
If Abs(f0 - f1) < wucha Then '无解
root = "无解"
ElseIf Abs(f0) < Abs(f1) Then
root = root(a,(a + b) / 2)
Else
End If
ElseIf f0 * f1 < 0 Then '异号,有1个或3个解
If fun1((a + b) / 2) * f0 < 0 Then
root = root(a,(a + b) / 2)
Else
root = root((a + b) / 2,b)
End If
End If
End Function
Private Sub Command1_Click()
Dim x As Single,a As Single,b As Single
a = Val(Text1(0).Text)
b = Val(Text1(1).Text)
Text1(2).Text = root(a,b)
Debug.Print fun1(Val(Text1(2).Text))
End Sub