Dim x0, x1, x2, x3, m_expr, i, x, Res, der, s_expr
Function Limit (expr, point) '取极限的近似值
Dim dif, i, nk, difk, ndifk, k, x
dif = 1
ndifk = 1000
x = point + dif
nk = Eval(expr)
For i = 1 To 3
dif = dif / 100
x = point + dif
k = Eval(expr)
difk = Abs(nk - k)
nk = k
'If difk < ndifk Then
'ndifk = difk
'Else
'Limit = "F"
'End If
Next
If Limit <> "F" Then Limit = k
End Function
Function Derivative (expr, point) '取导数的近似值
Dim Delta_x
Delta_x = 0.000001
Derivative = (Limit(expr, point + Delta_x) - Limit(expr, point))/Delta_x
End Function
s_expr = Inputbox("请输入关于x的一元方程" & vbCrLf & "注:指数是“^”,如 x^2 就是 x平方;乘号是“*”,不支持形如2x的写法,必须写成2*x")
m_expr = Mid(s_expr,1,InStr(s_expr,"=")-1) & "-(" & Mid(s_expr,InStr(s_expr,"=")+1,Len(s_expr)-InStr(s_expr,"=")) & ")"
x0 = 1
Do
x0 = Inputbox("请给出一个解的估计值 x0 ,输入exit退出", "初始值", x0)
If LCase(x0) = "exit" Then Exit Do
x = x0
Res = ""
For i = 1 To 1000
x = x0
der = Derivative(m_expr, x)
If der = 0 Then Msgbox "无法找到解!请尝试更换一个估计值!":Exit For
x1 = (Eval(m_expr)/der)
x0 = x0 - x1
If x1 = 0 Then
Exit For
End If
Next
If abs(x1) > 0.001 Then
Msgbox "解发散,无法求解!请尝试更换一个估计值!"
End If
If Abs(x0) < 1 Then x0 = "0" & x0
Msgbox s_expr & vbCrLf & vbCrLf & "x = " & x0 & vbCrLf & vbCrLf & "共计算" & i & "次"
Loop