本帖最后由 jyswjjgdwtdtj 于 2024-3-30 20:47 编辑
:D- 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
复制代码 网上的先进算法当然比这个写着好玩的强啦 |