一元三次方程求解

原创 2007年09月11日 23:29:00

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

 

一元三次方程求解

题目描述 有形如:ax3+bx2+cx+d=0 这样的一个一元三次方程。给出该方程中各项的系数(a,b,c,d 均为实数),并约定该方程存在三个不同实根(根的范围在-100至100之间),且根与根之...
  • ztz11
  • ztz11
  • 2017年11月30日 18:06
  • 151

一元三次方程求解

Sub SolveCubicEquations(ByVal CubicEquation As String, Optional ByVal x As String = "x", Optional By...
  • northwolves
  • northwolves
  • 2007年09月11日 23:29
  • 6629

一元三次方程求解

/* Name: 一元三次方程求解 Copyright: Author: Date: 22-01-18 15:08 Description: 一元三次方程求解 总时间限制: 1000m...
  • QiaoRuoZhuo
  • QiaoRuoZhuo
  • 2018年01月22日 15:22
  • 42

【Openjudge:Noi】7891:一元三次方程求解 c++

【Openjudge:Noi】7891:一元三次方程求解 总时间限制:  1000ms  内存限制:  65536kB 描述 有形如:ax3+bx2+cx+d=0  这样的一...
  • u013675643
  • u013675643
  • 2016年07月01日 16:25
  • 1362

求解一元三次方程--c++

#include #include #include//调用了fabs、pow函数 using namespace std;   double f(int,int,int,int,doubl...
  • u012221917
  • u012221917
  • 2013年12月06日 23:22
  • 2119

【092】韦达定理在一元n次方程中的推广

本文主要是把一元二次方程的韦达定理推广到一元n次方程上。证明过程使用了数学归纳法。...
  • zhangchao19890805
  • zhangchao19890805
  • 2017年10月14日 22:56
  • 894

解多元一次方程

题目描述 Description JOHN是个品学兼优的好学生,但由于智商问题,算术学得不是很好,尤其是在解方程这个方面。虽然他解决 2x=2 这样的方程游刃有余,但是对于 {x+y=3 ...
  • qq_37437983
  • qq_37437983
  • 2018年02月11日 19:52
  • 17

一元三次方程求解c++实现

typedef  double Number; class CubicRealPolynomial { public:     static Number computeDiscriminan...
  • zg260
  • zg260
  • 2014年11月21日 15:36
  • 1519

蓝桥网 算法训练 一元三次方程求解

问题描述   有形如:ax3+bx2+cx+d=0 这样的一个一元三次方程。给出该方程中各项的系数(a,b,c,d 均为实数),并约定该方程存在三个不同实根(根的范围在-100至100之间),且根与根...
  • ShiWaiGaoRen12345
  • ShiWaiGaoRen12345
  • 2016年11月06日 12:27
  • 369

算法训练 一元三次方程求解 蓝桥杯

问题描述   有形如:ax3+bx2+cx+d=0 这样的一个一元三次方程。给出该方程中各项的系数(a,b,c,d 均为实数),并约定该方程存在三个不同实根(根的范围在-100至100之间)...
  • sinat_35637319
  • sinat_35637319
  • 2017年02月25日 13:04
  • 745
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:一元三次方程求解
举报原因:
原因补充:

(最多只允许输入30个字)