Option Explicit
Sub main()
Dim [系数],result,output,i
[系数] = Split(InputBox("方程系数:",,"1 45 870 9450 63273 269325 723680 1172700 1026576 362880")," ")
result = [主函数]([系数])
For i = 0 To UBound(result)
result(i)=round(result(i),12)
Next
output = ""
If UBound(result) > 0 Then
For i = 0 To UBound(result)
output = output & "x" & i + 1 & "=" & result(i) & vbCrLf
Next
ElseIf UBound(result) = - 1 Then
output = "无解"
Else
output = "x=" & result(0)
End If
MsgBox output
End Sub
Call main
Function [主函数]([系数])
Dim [解],[导数],[极值],p,arr
If UBound([系数]) = 1 Then '一次
[解] = Array(-[系数](1)/[系数](0))
ElseIf UBound([系数]) = 0 Then
If [系数](0) = 0 Then
[解] = Array("所有实数")
Else
[解] = Array()
End If
Else
'高次
[导数] = [求导]([系数])
[极值] = [主函数]([导数])'x坐标
If UBound([极值]) = - 1 Then
[解] = Array(0)' 此时一定是奇数次幂函数
Else
Set arr = CreateObject("System.Collections.ArrayList")
For Each p In [极值]
arr.add([求值]([系数],p))'arr是极值点的y
Next
arr = arr.toarray()
Set [解] = CreateObject("System.Collections.ArrayList")
If UBound([系数]) Mod 2 = 0 Then
If [系数](0) > 0 Then
If arr(0) <= 0 Then [解].add([极值](0) - 1)
Else
If arr(0) >= 0 Then [解].add([极值](0) - 1)
End If
For p = 0 To UBound(arr) - 1
If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
Next
If [系数](0) > 0 Then
If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
Else
If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
End If
Else
If [系数](0) > 0 Then
If arr(0) >= 0 Then [解].add([极值](0) - 1)
Else
If arr(0) <= 0 Then [解].add([极值](0) - 1)
End If
For p = 0 To UBound(arr) - 1
If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
Next
If [系数](0) > 0 Then
If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
Else
If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
End If
End If
[解] = [解].toarray()
End If
Dim i,k,j,l,b
For i = 0 To UBound([解])
k = [解](i)
l=0'计数器 防止莫名其妙迭代不出
Do
j = k
k = j - [求值]([系数],j) / [求值]([导数],j)
If Abs(j - k) < 1 * 10 ^ (-15) or l>50 Then
k = Round(k,15)
Exit Do
End If
l=l+1
Loop
[解](i) = k
Next
End If
[主函数] = [解]
End Function
Function [求导]([系数]) '幂函数
Dim arr,k,i
Set arr = CreateObject("System.Collections.ArrayList")
k = UBound([系数])
For i = 0 To UBound([系数]) - 1
arr.add([系数](i) * (k - i))
Next
[求导] = arr.toarray()
End Function
Function [求值]([系数],[变量])
Dim k,j,i
k = UBound([系数])
j = 0
For i = 0 To UBound([系数])
j = j + [变量] ^ (k - i) * [系数](i)
Next
[求值] = j
End Function
Sub main()
Dim [系数],result,output,i
[系数] = Split(InputBox("方程系数:",,"1 45 870 9450 63273 269325 723680 1172700 1026576 362880")," ")
result = [主函数]([系数])
For i = 0 To UBound(result)
result(i)=round(result(i),12)
Next
output = ""
If UBound(result) > 0 Then
For i = 0 To UBound(result)
output = output & "x" & i + 1 & "=" & result(i) & vbCrLf
Next
ElseIf UBound(result) = - 1 Then
output = "无解"
Else
output = "x=" & result(0)
End If
MsgBox output
End Sub
Call main
Function [主函数]([系数])
Dim [解],[导数],[极值],p,arr
If UBound([系数]) = 1 Then '一次
[解] = Array(-[系数](1)/[系数](0))
ElseIf UBound([系数]) = 0 Then
If [系数](0) = 0 Then
[解] = Array("所有实数")
Else
[解] = Array()
End If
Else
'高次
[导数] = [求导]([系数])
[极值] = [主函数]([导数])'x坐标
If UBound([极值]) = - 1 Then
[解] = Array(0)' 此时一定是奇数次幂函数
Else
Set arr = CreateObject("System.Collections.ArrayList")
For Each p In [极值]
arr.add([求值]([系数],p))'arr是极值点的y
Next
arr = arr.toarray()
Set [解] = CreateObject("System.Collections.ArrayList")
If UBound([系数]) Mod 2 = 0 Then
If [系数](0) > 0 Then
If arr(0) <= 0 Then [解].add([极值](0) - 1)
Else
If arr(0) >= 0 Then [解].add([极值](0) - 1)
End If
For p = 0 To UBound(arr) - 1
If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
Next
If [系数](0) > 0 Then
If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
Else
If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
End If
Else
If [系数](0) > 0 Then
If arr(0) >= 0 Then [解].add([极值](0) - 1)
Else
If arr(0) <= 0 Then [解].add([极值](0) - 1)
End If
For p = 0 To UBound(arr) - 1
If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
Next
If [系数](0) > 0 Then
If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
Else
If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
End If
End If
[解] = [解].toarray()
End If
Dim i,k,j,l,b
For i = 0 To UBound([解])
k = [解](i)
l=0'计数器 防止莫名其妙迭代不出
Do
j = k
k = j - [求值]([系数],j) / [求值]([导数],j)
If Abs(j - k) < 1 * 10 ^ (-15) or l>50 Then
k = Round(k,15)
Exit Do
End If
l=l+1
Loop
[解](i) = k
Next
End If
[主函数] = [解]
End Function
Function [求导]([系数]) '幂函数
Dim arr,k,i
Set arr = CreateObject("System.Collections.ArrayList")
k = UBound([系数])
For i = 0 To UBound([系数]) - 1
arr.add([系数](i) * (k - i))
Next
[求导] = arr.toarray()
End Function
Function [求值]([系数],[变量])
Dim k,j,i
k = UBound([系数])
j = 0
For i = 0 To UBound([系数])
j = j + [变量] ^ (k - i) * [系数](i)
Next
[求值] = j
End Function