Sub SolveCubicEquations(ByVal CubicEquation As String, Optional ByVal x As String = "x", Optional ByRef result As String)
Dim a As Single, b As Single, c As Single, d As Single, temp As String, n As Byte
Dim f As Single, g As Single, h As Single, i As Single, j As Single, alpha As Single
CubicEquation = Replace(CubicEquation, " ", "")
result = Replace(CubicEquation, "-", "+-")
s = Split(Split(result, "=")(0), "+")
For n = 0 To UBound(s)
If s(n) Like "*" & x & "^3" Then temp = Trim(Split(s(n), x)(0)): a = IIf(temp = "-", -1, IIf(temp = "", 1, Val(temp)))
If s(n) Like "*" & x & "^2" Then temp = Trim(Split(s(n), x)(0)): b = IIf(temp = "-", -1, IIf(temp = "", 1, Val(temp)))
If s(n) Like "*" & x Then temp = Trim(Split(s(n), x)(0)): c = IIf(temp = "-", -1, IIf(temp = "", 0, Val(temp)))
If IsNumeric(s(n)) Then d = s(n)
Next
f = c / a - b * b / (3 * a * a)
g = 2 * b ^ 3 / (3 * a) ^ 3 - b * c / (3 * a * a) + d / a
h = g ^ 2 / 4 + f ^ 3 / 27
Select Case Sgn(h)
Case -1 'Roots Are Real
i = Sqr(g ^ 2 / 4 - h)
j = -g / (2 * i)
If j = 1 Then alpha = 0
If j <> 1 Then alpha = (Atn(-j / Sqr(1 - j ^ 2)) + 2 * Atn(1)) / 3
result = "Cubic Equations {" & CubicEquation & "} has 3 Real Roots:" & vbCrLf & String(50, "-")
result = result & vbCrLf & x & "1=" & Format(2 * i ^ (1 / 3) * Cos(alpha) - b / (3 * a), "0.0000")
result = result & vbCrLf & x & "2=" & Format(-i ^ (1 / 3) * (Cos(alpha) + (3 ^ 0.5) * Sin(alpha)) - b / (3 * a), "0.0000")
result = result & vbCrLf & x & "3=" & Format(-i ^ (1 / 3) * (Cos(alpha) - (3 ^ 0.5) * Sin(alpha)) - b / (3 * a), "0.0000")
Case 0 'All 3 Roots Are Real and Equal
result = "Cubic Equation {" & CubicEquation & "} has 3 Equal Real Roots:" & vbCrLf & String(50, "-")
result = result & vbCrLf & x & "1=" & Format(-(d / a) ^ (1 / 3), "0.0000")
result = result & vbCrLf & x & "2=" & Format(-(d / a) ^ (1 / 3), "0.0000")
result = result & vbCrLf & x & "3=" & Format(-(d / a) ^ (1 / 3), "0.0000")
Case 1 'Only 1 Root Is Real
i = (-g / 2 + h ^ 0.5) ^ (1 / 3)
j = -(g / 2 + h ^ 0.5) ^ (1 / 3)
result = "Cubic Equations {" & CubicEquation & "} has only 1 Real Roots:" & vbCrLf & String(50, "-")
result = result & vbCrLf & x & "1=" & Format(i + j - b / (3 * a), "0.0000")
result = result & vbCrLf & x & "2=" & Format(-(i + j) / 2 - b / (3 * a), "0.0000") & "+" & Format(Abs(i - j) * 3 ^ 0.5 / 2, "0.0000") & "*i"
result = result & vbCrLf & x & "3=" & Format(-(i + j) / 2 - b / (3 * a), "0.0000") & "-" & Format(Abs(i - j) * 3 ^ 0.5 / 2, "0.0000") & "*i"
End Select
result = Replace(result, "0.0000+", "")
result = Replace(result, "0.0000-", "")
result = Replace(result, "0.0000", 0)
result = Replace(result, ".0000", "")
result = result & vbCrLf
Debug.Print result
End Sub
Sub macro1()
SolveCubicEquations "2x^3-4x^2-22x+24=0"
SolveCubicEquations "x^3 + 6x^2 + 12x + 8 = 0"
SolveCubicEquations "y^3 + 7y -9 = 0", "y"
SolveCubicEquations "3z^3 + 5z = 0", "z"
SolveCubicEquations "-2x^3 + 8x^2 = 0", "x"
End Sub
返回:
Cubic Equations {2x^3-4x^2-22x+24=0} has 3 Real Roots:
--------------------------------------------------
x1=4
x2=-3
x3=1
Cubic Equation {x^3+6x^2+12x+8=0} has 3 Equal Real Roots:
--------------------------------------------------
x1=-2
x2=-2
x3=-2
Cubic Equations {y^3+7y-9=0} has only 1 Real Roots:
--------------------------------------------------
y1=1.0971
y2=-0.5485+2.8112*i
y3=-0.5485-2.8112*i
Cubic Equations {3z^3+5z=0} has only 1 Real Roots:
--------------------------------------------------
z1=0
z2=1.2910*i
z3=1.2910*i
Cubic Equations {-2x^3+8x^2=0} has 3 Real Roots:
--------------------------------------------------
x1=4
x2=0
x3=0
分享到:
相关推荐
C++实现了一元三次方程的求解,利用二分法求解,只需要输入一元三次方程的四个系数,就可以求出实数解
该软件是C# WinForm应用程序,用以求解一元三次方程的动态运算工具。 如:a * x + b * x^2 + c * x^3 + d=0 的一元三次方程,其中a、b、c、d均为常数,手动输入改常数,即可动态运算求得结果
vb小程序,一元三次方程求根计算。用Visual Basic开发的
一元三次方程求解的C++实现,采用公式计算,采用c++实现
在C++平台,利用盛金公式求解一元三次方程的根
一元三次方程求解器,非常好用。和大家分享一下
有形如:ax3+bx2+cx+d=0 这样的一个一元三次方程。给出该方程中各项的系数(a,b,c,d 均为实数),并约定该方程存在三个不同实根(根的范围在-100至100之间),且根与根之差的绝对值>=1。要求由小到大依次在同一行输出...
输入格式 四个实数:a,b,c,d输出格式 由小到大依次在同一行输出这三个实根(根与根之间留有空格),并精确到小数点后2位样例输入1 -5 -4 20样例输
一元三次方程求解 题目描述 有形如:ax3+bx2+cx+d=0 这样的一个一元三次方程。给出该方程中各项的系数(a,b,c,d 均为实数),并约定该方程存在三个不同实根(根的范围在-100至100之间),且根与根之差的绝对值>=1。...
自己测的没问题,在CSCD博客上下载来自己用,发现有问题,自己修改后没问题了。
根的c 语言程序[4]. # include main() {float a,b,c,d; float xo x1,x2,f0 f1,f2; printf("请输入方程系数 a,b,c,d;"); scanf("%f,%f,%f,%f",&a,&b,&c,&d");...loop:printf("方程的根 x=%f\n",x0); }
方程求解源代码,包括一元二次方程,一元三次方程,一元四次方程。使用求根公式进行求解,解为复数解,二次方程总是有两个解,三次方程总是有三个解,四次方程总是有四个解。如果只需要实数解,可判断虚部是否为0。
C#完整的解一元三次方程,盛金公式法。直接生成dll文件,直接调用即可。
洛谷P1024源代码
一元二次方程 MFC实现 考虑了三种情况;
c++编程,函数调用实现一元二次方程求解。分成系数输入、方程求解、三角函数求解和结果输出四个函数,利用全局变量调用函数里面返回的一元二次方程的根在接下去的函数里继续调用。
蓝桥杯VIP题和题解
java写的简单的一元二次方程求解希望大家有兴趣的下了看看
用牛顿迭代法求一元三次方程的解,可以全面的求解,而非像一般的算法只能求出一个解
计算方法实验报告-一元三次方程求解C语言编程.doc