Board logo

标题: [技术讨论] 一个解方程的VBS小程序~ [打印本页]

作者: jyswjjgdwtdtj    时间: 2024-2-23 22:15     标题: 一个解方程的VBS小程序~

本帖最后由 jyswjjgdwtdtj 于 2024-3-30 20:47 编辑

:D
  1. Option Explicit
  2. Sub main()
  3.     Dim [系数],result,output,i
  4.     [系数] = Split(InputBox("方程系数:",,"1 45 870 9450 63273 269325 723680 1172700 1026576 362880")," ")
  5.     result = [主函数]([系数])
  6.         For i = 0 To UBound(result)
  7.             result(i)=round(result(i),12)
  8.         Next
  9.     output = ""
  10.     If UBound(result) > 0 Then
  11.         For i = 0 To UBound(result)
  12.             output = output & "x" & i + 1 & "=" & result(i) & vbCrLf
  13.         Next
  14.     ElseIf UBound(result) =  - 1 Then
  15.         output = "无解"
  16.     Else
  17.         output = "x=" & result(0)
  18.     End If
  19.     MsgBox output
  20. End Sub
  21. Call main
  22. Function [主函数]([系数])
  23.     Dim [解],[导数],[极值],p,arr
  24. If UBound([系数]) = 1 Then '一次
  25.     [解] = Array(-[系数](1)/[系数](0))
  26. ElseIf UBound([系数]) = 0 Then
  27.     If [系数](0) = 0 Then
  28.         [解] = Array("所有实数")
  29.     Else
  30.         [解] = Array()
  31.     End If
  32. Else
  33.     '高次
  34.     [导数] = [求导]([系数])
  35.     [极值] = [主函数]([导数])'x坐标
  36.     If UBound([极值]) =  - 1 Then
  37.         [解] = Array(0)' 此时一定是奇数次幂函数
  38.     Else
  39.         Set arr = CreateObject("System.Collections.ArrayList")
  40.         For Each p In [极值]
  41.             arr.add([求值]([系数],p))'arr是极值点的y
  42.         Next
  43.         arr = arr.toarray()
  44.         Set [解] = CreateObject("System.Collections.ArrayList")
  45.         If UBound([系数]) Mod 2 = 0 Then
  46.             If [系数](0) > 0 Then
  47.                 If arr(0) <= 0 Then  [解].add([极值](0) - 1)
  48.             Else
  49.                 If arr(0) >= 0 Then  [解].add([极值](0) - 1)
  50.             End If
  51.             For p = 0 To UBound(arr) - 1
  52.                 If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
  53.             Next
  54.             If [系数](0) > 0 Then
  55.                 If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
  56.             Else
  57.                 If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
  58.             End If
  59.         Else
  60.             If [系数](0) > 0 Then
  61.                 If arr(0) >= 0 Then  [解].add([极值](0) - 1)
  62.             Else
  63.                 If arr(0) <= 0 Then  [解].add([极值](0) - 1)
  64.             End If
  65.             For p = 0 To UBound(arr) - 1
  66.                 If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
  67.             Next
  68.             If [系数](0) > 0 Then
  69.                 If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
  70.             Else
  71.                 If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
  72.             End If
  73.         End If
  74.         [解] = [解].toarray()
  75.     End If
  76.     Dim i,k,j,l,b
  77.     For i = 0 To UBound([解])
  78.         k = [解](i)
  79.         l=0'计数器 防止莫名其妙迭代不出
  80.         Do
  81.             j = k
  82.             k = j - [求值]([系数],j) / [求值]([导数],j)
  83.             If Abs(j - k) < 1 * 10 ^ (-15) or l>50 Then
  84.                 k = Round(k,15)
  85.                 Exit Do
  86.             End If
  87. l=l+1
  88.         Loop
  89.         [解](i) = k
  90.     Next
  91. End If
  92. [主函数] = [解]
  93. End Function
  94. Function [求导]([系数]) '幂函数
  95. Dim arr,k,i
  96. Set arr = CreateObject("System.Collections.ArrayList")
  97. k = UBound([系数])
  98. For i = 0 To UBound([系数]) - 1
  99.     arr.add([系数](i) * (k - i))
  100. Next
  101. [求导] = arr.toarray()
  102. End Function
  103. Function [求值]([系数],[变量])
  104. Dim k,j,i
  105. k = UBound([系数])
  106. j = 0
  107. For i = 0 To UBound([系数])
  108.     j = j + [变量] ^ (k - i) * [系数](i)
  109. Next
  110. [求值] = j
  111. End Function
复制代码
网上的先进算法当然比这个写着好玩的强啦
作者: czjt1234    时间: 2024-2-24 07:00

无聊你写个读写解析json的呗
作者: jyswjjgdwtdtj    时间: 2024-2-24 09:30

回复 2# czjt1234


    像我这种人写出来的东西肯定丑死了




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2