[原创]1元3次方程的高精度求解程序

ysr

[这个贴子最后由ysr在 2013/12/22 07:11pm 第 1 次编辑]

[watermark]如下为用飘飘版公式弄出的可执行程序(重新调试整理了1下)：

ysr

用飘飘版公式弄出的可执行程序(重新调试整理了1下),下面是代码:

ysr

这里有代码！

风花飘飘

《鲍赫公式》编程就简单多了：
（著作权拥有者：王彦会）

Private Sub Command1_Click()
Dim a, b, c
a = Text1.Text
b = Text2.Text
c = Text3.Text
If c = 0 Then
   Text4.Text = "c 不能为 0"
   Text5.Text = "c 为 0可能已不是1元3次方程"
   
    Else
   
m = 36 * Val(a) * Val(b) - 8 * Val(a) ^ 3 - 108 * Val(c)
n1 = Val(m) ^ 2 + (12 * Val(b) - 4 * Val(a) ^ 2) ^ 3
If n1 < 0 Then
n2 = Sqr(Abs(n1))
Else
n2 = Sqr(Val(n1))
End If
If n1 < 0 And m <> 0 Then
jq = (Sqr(Val(m) ^ 2 + Val(n2) ^ 2)) ^ (1 / 3)
jq1 = Atn(Val(n2) / Val(m))
q = Val(jq) * Cos(Val(jq1) / 3)
p = q
Else
If Val(m) + Val(n2) < 0 Then
p = -(Abs(Val(m) + Val(n2))) ^ (1 / 3)
Else
p = (Val(m) + Val(n2)) ^ (1 / 3)
End If
If Val(m) < Val(n2) Then
q = -(Val(n2) - Val(m)) ^ (1 / 3)
Else
  
q = (Val(m) - Val(n2)) ^ (1 / 3)
   
End If

  End If
  
End If
If a = 0 And b = 0 Then
Text4.Text = (Val(p) + Val(q) - 2 * Val(a)) / 6
Text5.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 & "+" & (3 ^ (1 / 2) * (Val(p) - Val(q))) / 12 & "i"
Text6.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 & "+" & -(3 ^ (1 / 2) * (Val(p) - Val(q))) / 12 & "i"
Else
If n1 >= 0 Then
d = (Val(p) + Val(q) - 2 * Val(a)) / 6
Else
If m = 0 Then
d = (Val(p) + Val(q) - 2 * Val(a)) / 6
Else
d = (Val(p) + Val(q) - 2 * Val(a)) / 6
End If

End If
jb = Val(a) + Val(d)
jc = Val(b) + Val(d) * (Val(a) + Val(d))
jd = Val(jb) ^ 2 - 4 * Val(jc)
If Val(jd) >= 0 Then
Text4.Text = d
Text5.Text = -Val(jb) / 2 + Sqr(Val(jd)) / 2
Text6.Text = -Val(jb) / 2 - Sqr(Val(jd)) / 2
Else
Text4.Text = d
Text5.Text = -Val(jb) / 2 & " +" & Sqr(Abs(jd)) / 2 & "i"
Text6.Text = -Val(jb) / 2 & -Sqr(Abs(jd)) / 2 & "i"
End If
End If

End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub

风花飘飘

《数学中国》ZHAOLU84编程验码：


用下面在VF下按鲍赫公式编程：
CLEAR
CLEAR ALL
use scxsk
e=1
GO 2
a=xs
GO 3
b=xs
GO 4
c=xs
m=36*a*b-8*a*a*a-108*c
r=m*m
s=4*a*a-12*b
n=sqrt(r-s*s*s)
p=(m+n)^(1/3)
q=0
IF ABS(p)<0.00000000001
q=(m-n)^(1/3)
ELSE
q=s/p
ENDIF
x=((p+q)-2*a)/6
?x
u=-((p+q)+4*a)/12
v=(SQRT(3)*(p-q))/12
?'u=',u
?'v=',v
GO 1
REPLACE sb with x
GO 2
REPLACE sb with u,xb with v
GO 3
REPLACE sb with u,xb with -v
zz=x*x*x+a*x*x+b*x+c
GO 1
REPLACE ysb with zz
g=SQRT(u*u+v*v)
t=ACOS(u/g)
scs=g*g*g*COS(3*t)
scx=g*g*g*SIN(3*t)
ecs=g*g*COS(2*t)
ecx=g*g*SIN(2*t)
ycs=g*COS(t)
ycx=g*SIN(t)
sba=scs+a*ecs+b*ycs+c
xba=scx+a*ecx+b*ycx
GO 2
REPLACE ysb with sba,yxb with xba
GO 3
REPLACE ysb with sba,yxb with xba

解方程x^3+2x^2+3x+4，输出结果如下，
XS  JM                    SB H                XB XD                YSB                 YXB
1.0 x(1)= -1.650629191439387   0.000000000000000     0.000000000000004                    
2.0 x(2)= -0.174685404280306 + 1.546868887231396 i   0.000000000000004   0.000000000000001
3.0 x(3)= -0.174685404280306 - 1.546868887231396 i   0.000000000000004  -0.000000000000001
4.0                                                                     
验实部误差为0.000000000000004，
验虚部误差为0.000000000000001。
确实是“本公式作为三次方程的通解公式，在应用的计算程序方面已经达到最优化了”!

风花飘飘

ysr

《鲍赫公式》相当部错，继续研究下去可能有大收获，可能解决高次方程根式解。

ysr

修改后的程序和代码（上面下载过的可以用下面的代替）：

ysr

如下为代码，供参考，

ysr

输入1:  a=4,  b=,  c=-3,  d=-1(√30+√10-√6-√2-2√21.708203932499369089227521006193+2√7.2360679774997896964091736687313)/16;  输出结果1:    x1=0.8746197071,  x2=-0.0174524064,  x3=-0.8571673007 m=1.4130708185 n=26.9629974384i
下面程序及代码可以输出m和n的值，供参考：