| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 6084 人关注过本帖
标题:高精度大数据一元三次方程求解程序
只看楼主 加入收藏
cuituo
Rank: 2
等 级:论坛游民
威 望:2
帖 子:29
专家分:22
注 册:2008-6-21
收藏
得分:0 
我的计算结果是 Text11  输入1:  a=1,  b=-12345,  c=1234567,  d=12345678;  输出结果1:    x1=12244.0880091551,  x2=110.0723067874,  x3=-9.1603159426 m=14500928109636 n=368462042858.2718398890i
2023-03-10 23:36
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:921
专家分:77
注 册:2020-2-10
收藏
得分:0 
回复 11楼 cuituo
您输入的符号不对了,d的值应该是负号吧。人家输入的abcd的符号分别是+-+-,您是+-++了。
2023-03-10 23:55
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:921
专家分:77
注 册:2020-2-10
收藏
得分:0 
回复 11楼 cuituo
Text11  输入1:  a=1,  b=-12345,  c=1234567,  d=-12345678;  输出结果1:    x1=12244.2540738510,  x2=89.4773378978,  x3=11.2685882512 m=14503594776084 n=241699997947.2347696182i
2023-03-11 00:10
mrexcel
Rank: 6Rank: 6
等 级:贵宾
威 望:22
帖 子:126
专家分:480
注 册:2022-11-3
收藏
得分:0 
一元三次方程求解,可直接调用盛金公式或卡丹公式判断后 求解
2023-03-17 14:45
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:921
专家分:77
注 册:2020-2-10
收藏
得分:0 
Dim sng As Integer 'shuru zifu & '"√"41420
'具体方法是:先切换到非英语输入法(如:五笔/拼音),
'然后在输入法的状态栏上看到像键盘一样的按钮,在按钮上按右键,选"希腊字母",
'根着你就可在软键盘上看到你要的符号了.
'2"178",3"179",×"215",÷"247",°"176"

'解四次方程的代码如下:
Private Sub Command1_Click()
Dim a, b, c, d, f, g
Dim ja, jb, jc
k = DeleteSpace(Text1.Text)
ja = DeleteSpace(Text2.Text)
jb = DeleteSpace(Text3.Text)
jc = DeleteSpace(Text4.Text)
jd = DeleteSpace(Text5.Text)
sd1 = DeleteSpace(Text14.Text)
If Abs(Val(sd1)) <= 10 Then
sd = 10 + 2
Else
If Len(sd1) > 3 And Abs(Val(sd1)) > 300 Then
sd = 300 + 2
Else
sd = Int(Abs(Val(sd1))) + 2
End If
End If

a2 = zhengliys2(Trim(ja), Val(sd))
b2 = zhengliys2(Trim(jb), Val(sd))

C2 = zhengliys2(Trim(jc), Val(sd))
D2 = zhengliys2(Trim(jd), Val(sd))
k2 = zhengliys2(Trim(k), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
Text4.Text = "a 不能为 0"
   Text5.Text = "a 为 0可能已不是1元4次方程"
  Else
   
a3 = mcc2(Trim(a2), Trim(k2), Val(sd))
b3 = mcc2(Trim(b2), Trim(k2), Val(sd))
c3 = mcc2(Trim(C2), Trim(k2), Val(sd))
d3 = mcc2(Trim(D2), Trim(k2), Val(sd))
jk = 8 & String(sd, "0")
ja1 = mbc2("-4" & String(sd, "0"), Trim(b3), Val(sd))
jb1 = mpc2(mbc2(2 & String(sd, "0"), mbc2(Trim(a3), Trim(c3), Val(sd)), Val(sd)), mbc2(8 & String(sd, "0"), Trim(d3), Val(sd)))
jc1 = mpc2(mbc2(Trim(d3), mpc2(mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), Val(sd)), mbc2(Trim(c3), Trim(c3), Val(sd)))
Y = jie3cifc(Trim(ja1), Trim(jb1), Trim(jc1), Trim(jk), Val(sd))
Y1 = zhengliys2(Trim(Y), Val(sd))
End If
Text6 = zhengliys2(Trim(Y), Val(sd))
Text8 = Y
za = 1 & String(sd, "0")
z2 = mpc2(mpc3(mbc2(8 & String(sd, "0"), Trim(Y1), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)))
z2 = mbbc2(qdfh(Trim(z2)), Val(sd))

zb1 = mcc2(mpc3(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zb2 = mcc2(mpc2(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zc1 = mpc3(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
zc2 = mpc2(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
y3 = jie2cifc(Trim(za), Trim(zb1), Trim(zc1), Val(sd))
y4 = jie2cifc(Trim(za), Trim(zb2), Trim(zc2), Val(sd))
Text9 = y3
Text10 = y4

Text15.Text = Text15.Text & "  输入" & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & ",e=" & jd & ";  输出结果" & ":    " & "x1,2=" & Text9.Text & ",  x3,4=" & Text10.Text
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""

Text6 = ""
Text7 = ""
Text8 = ""
Text9 = ""

Text10 = ""
Text11 = ""
Text12 = ""
Text13 = ""

Form1.Cls
End Sub
Public Function jie3cifc(a2 As String, b2 As String, C2 As String, k2 As String, sd As String) As String '3次方程
a3 = mcc2(Trim(a2), Trim(k2), Val(sd))
b3 = mcc2(Trim(b2), Trim(k2), Val(sd))
c3 = mcc2(Trim(C2), Trim(k2), Val(sd))


   
   
   ' m = 36 * Val(ja) * Val(jb) - 8 * Val(ja) ^ 3 - 108 * Val(jc)
   If mbjc2(Trim(a3), 0) = 0 And mbjc2(Trim(b3), 0) = 0 Then
   m = mbc2(-108 & String(sd, "0"), Trim(c3), Val(sd))
   
   n4 = qdfh(mbc2(Trim(m), Trim(m), Val(sd)))
   Else
   
   m1 = mbc2(mbc2(Trim(a3), Trim(b3), Trim(sd)), Val(36) & String(sd, "0"), Val(sd))
   m2 = mbc2(mbc2(mbc2(Trim(a3), Trim(a3), Trim(sd)), Trim(a3), Val(sd)), Val(8) & String(sd, "0"), Val(sd))
   m3 = mbc2(Trim(c3), Val(108) & String(sd, "0"), Val(sd))
   m = mpc2(mpc2(Trim(m1), Trim(m2)), Trim(m3))
  Print "m="; m
  
'n1 = Val(m) ^ 2 + (12 * Val(B) - 4 * Val(A) ^ 2) ^ 3

  n1 = mbc2(Trim(m), Trim(m), Val(sd))
    n2 = mpc2(mbc2(Trim(b3), Val(12) & String(sd, "0"), Val(sd)), mbc2(mbc2(Trim(a3), Trim(a3), Val(sd)), Val(4) & String(sd, "0"), Val(sd)))
     n3 = mbc2(mbc2(Trim(n2), Trim(n2), Val(sd)), Trim(n2), Val(sd))
     n4 = mpc3(Trim(n1), Trim(n3))
     End If
     fn4 = fhys(Trim(n4))
    n5 = mbbc2(qqdl(qdfh(Trim(n4))), Val(sd))
   Print "n5="; n5
   
    'If n1 < 0 And m < 0 Then
    If Val(fn4) < 0 And Val(fhys(Trim(m))) < 0 Then
    'n=(93312R^6+311040R^5+285120R^4+221824R^3+27020R^2+3712R+320)^(1/2)
    'a=-(2+81k)
    'm=216r^3+360r^2+128r-8
    'k=(n^2/m^2)/27
    ''a1=(M/8*(9t-1))^(1/3),,b1=a1*(t)^(1/2)
    '令m=19683N^6+1215N^4M^2+17N^2M^4-M^6,
'm1=243N^4+3N^2M^2+M^4,
'n=(m^2-m1^3)^(1/2),
'则:t=(((m+n)^(1/3)+(m-n)^(1/3))+(2*M^2+3*N^2))/(3*M^2),
''其中M≠m,N≠n,
   jq = mbbc3(mbbc2(qqdl(MPC1(mbc2(qdfh(Trim(m)), qdfh(Trim(m)), Val(sd)), mbc2(qdfh(Trim(n5)), qdfh(Trim(n5)), Val(sd)))), Val(sd)), Val(sd))
   jq3 = mcc2(Trim(n5), Trim(m), Val(sd))
   jq1 = jsfanzq(mcc2(Trim(n5), Trim(m), Val(sd)), Val(sd))
   Print "jq3="; jq3
   Print "jq1="; jq1
   q1 = mbc2(Trim(jq), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), Val(sd))
   
   Print "q1="; q1
   
   If Val(fhys(Trim(q1))) > 0 Then
  q = tjfh(Trim(q1), Val(-1))
  Else
  q = qdfh(Trim(q1))
  End If
   jq3 = mbbc2(MPC(1 & String(sd, "0"), mbc2(jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), _
   Val(sd))), Val(sd))
   jq2 = tjfh(Trim(jq3), Val(-1))
   Print "jq2="; jq2
   
   qa = mbc2(Trim(jq), Trim(jq2), Val(sd))
   p = q
   pa = qa
  Else
  'If n1 < 0 And m > 0 Then
If Val(fn4) < 0 And MBJC(qdfh(Trim(m)), 0) > 0 Then

jq = mbbc3(mbbc2(qqdl(MPC1(mbc2(qdfh(Trim(m)), qdfh(Trim(m)), Val(sd)), mbc2(qdfh(Trim(n5)), qdfh(Trim(n5)), Val(sd)))), Val(sd)), Val(sd))
   jq1 = jsfanzq(mcc2(Trim(n5), Trim(m), Val(sd)), Val(sd))
   jq3 = mcc2(Trim(n5), Trim(m), Val(sd))
   q = mbc2(Trim(jq), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), Val(sd))
   jq2 = mbbc2(MPC(1 & String(sd, "0"), mbc2(jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), _
   Val(sd))), Val(sd))
   Print "jq3="; jq3
   Print "jq1="; jq1
   Print "q"; q
   Print "jq2="; jq2
   qa = mbc2(Trim(jq), Trim(jq2), Val(sd))
   p = q
   pa = qa
Else
'If Val(m) + Val(n2) < 0 Then
If fhys(mpc3(Trim(m), Trim(n5))) = -1 Then
p = "-" & mbbc3(qdfh(mpc3(Trim(m), Trim(n5))), Val(sd))
Else
p = mbbc3(mpc3(Trim(m), Trim(n5)), Val(sd))

End If

'If Val(m) < Val(n2) Then
If mbjc2(Trim(m), Trim(n5)) = -1 Then
'q = -(Val(n2) - Val(m)) ^ (1 / 3)
q = "-" & mbbc3(qdfh(mpc2(Trim(n5), Trim(m))), Val(sd))
Else
q = mbbc3(mpc2(Trim(m), Trim(n5)), Val(sd))

End If



  End If
  
  
  End If
  
  'If a = 0 And b = 0 Then
  If Val(fn4) > 0 And mbjc2(Trim(n4), 0) <> 0 Then  'Val(n4) > 0 Or mbjc2(Trim(n4), 0) = 0
  tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = zhengchuqy(MCC1(qdfh(mbc2(mpc2(Trim(p), Trim(q)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd))), 12))
jie3cifc = shuchujg(Trim(tx1), Val(sd))

  Else
  If Mid(fn4, 1, 1) = "-" And Trim(m) = 0 Or Trim(n5) = 0 Then
tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = mcc2(mbc2(mpc2(Trim(p), Trim(q)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd)), 12 & String(sd, "0"), Val(sd))
  If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  tx1 = shuchujg(Trim(tx1), Val(sd))
tx12 = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  tx13 = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  tx14 = tx1 & "/" & tx12 & "/" & tx13
  jie3cifc = max(Trim(tx14))
  
  Else
  
  'd = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  'd = mcc2(MPC(qdfh(mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), mpc3(Trim(p), Trim(q))), 6 & String(sd, "0"), Val(sd))
  'mpc2减法器有问题?
  'fd = fhys(Trim(d))
  tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = mcc2(mbc2(mpc3(Trim(pa), Trim(qa)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd)), 12 & String(sd, "0"), Val(sd))
If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  tx1 = shuchujg(Trim(tx1), Val(sd))
tx12 = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  tx13 = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  tx14 = tx1 & "/" & tx12 & "/" & tx13
  jie3cifc = max(Trim(tx14))

  End If
  
End If


  


  

End Function

Private Function max(ByVal lists As String) As String
Dim temp As String
Dim a() As String
a = Split(lists, "/")
Dim b As Long
temp = a(0)
For b = 0 To UBound(a)
If Abs(temp) < Abs(a(b)) Then temp = a(b)
Next
max = temp
End Function


[此贴子已经被作者于2026-3-4 13:38编辑过]

2026-02-28 13:33
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:921
专家分:77
注 册:2020-2-10
收藏
得分:0 
这个结果也对:输入:  a=1,  b=2,  c=-3,  d=4,e=5;  输出结果:    x1,2=-1.9556023509+ -1.2268754722,  x3,4=0.9556023509+ -1.1148003552i

因为其中的解2次方程的可调用程序不同,代码如下:
Public Function jie2cifc(a2 As String, b2 As String, C2 As String, sd As String) As String '2次方程
Dim d, Y
d = mbc2(Trim(b2), Trim(b2), Val(sd))
D1 = mpc2(Trim(d), mbc2(4 & String(sd, "0"), mbc2(Trim(a2), Trim(C2), Val(sd)), Val(sd)))
d3 = qdfh(Trim(D1))
D2 = mbbc2(Trim(d3), Val(sd))
Y = mcc2(Trim(b2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
sf = fhys(Trim(Y))
sf = Val(-1 * sf)
Y = tjfh(qdfh(Trim(Y)), Val(sf))
Y = shuchujg(Trim(Y), Val(sd))
If mbjc2(Trim(D1), 0) >= 0 Then
d3 = mcc2(Trim(D2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd))
Else
d3 = mcc2(Trim(D2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd)) & "i"
End If
jie2cifc = Y & "+ -" & d3
End Function
2026-02-28 17:18
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:921
专家分:77
注 册:2020-2-10
收藏
得分:0 
这个结果也对:输入:  a=1,  b=2,  c=-3,  d=4,e=5;  输出结果:    x1,2=-0.7287268787, -3.1824778231,  x3,4=0.9556023509+ -1.1148003552i

因为其中的解2次方程的可调用程序不同,代码如下:
Public Function jie2cifc(a2 As String, b2 As String, c2 As String, sd As String) As String '2次方程
Dim d, y
b3 = b2
b2 = qdfh(b2)
d = mbc2(Trim(b2), Trim(b2), Val(sd))
D1 = mpc2(Trim(d), mbc2(4 & String(sd, "0"), mbc2(Trim(a2), Trim(c2), Val(sd)), Val(sd)))
d3 = qdfh(Trim(D1))
D2 = mbbc2(Trim(d3), Val(sd))
y = mcc2(Trim(b2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
sf = fhys(Trim(b3))
sf = Val(-1 * sf)
y = tjfh(qdfh(Trim(y)), Val(sf))
If mbjc2(Trim(D1), 0) >= 0 Then
d3 = mcc2(Trim(D2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
Y1 = mpc3(Trim(y), Trim(d3))
Y2 = mpc2(Trim(y), Trim(d3))
y = shuchujg(Trim(Y1), Val(sd))
d3 = shuchujg(Trim(Y2), Val(sd))
jie2cifc = y & ", " & d3
Else
y = shuchujg(Trim(y), Val(sd))
d3 = mcc2(Trim(D2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd)) & "i"
jie2cifc = y & "+ -" & d3
End If


End Function
2026-02-28 17:20
快速回复:高精度大数据一元三次方程求解程序
数据加载中...
 
   
关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.018433 second(s), 8 queries.
Copyright©2004-2026, BCCN.NET, All Rights Reserved