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

ysr

能做出sin10度，就可以做出sin40度，则9等分圆就可以作图了。

ysr

Private Function jszhxian(sa As String, sd As String) As String
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)


Loop

jszhxian = mbc2(Trim(sa), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
End Function




Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If


End Function

Private Function jsyuxian(sa As String, sd As String) As String
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsyuxian = jszhxian(MPC(jspaizh(Val(sd)), qdfh(Trim(sa))), Val(sd))
Else
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 2
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)


Loop

jsyuxian = mpc3(Val(1) & String(Val(sd), "0"), Trim(s))
End If
End Function

这两个程序可能有用，可以用来计算高精度的正弦和余弦。

ysr

Private Function jspaizh(sd As String) As String '派/2=1+1/3+1*2/3*5+1*2*3/3*5*7+……
'应该是 Pi/4=1-1/3+1/5-1/7+…+（-1）^(n-1)/(2*n-1)吧，呵呵
'派/2=2/1*2/3*4/3*4/5^^^^^=2*2/1*3*4*4/3*5*6*6/5*7*^^^^^^^
Dim s1 As String
s1 = "31415926535 8979323846 2643383279 5028841971 6939937510 5820974944 5923078164 0628620899 8628034825 3421170679 8214808651 32823066470938446095 5058223172 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 4428810975 6659334461 2847564823 37867831652712019091 4564856692 3460348610 4543266482 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 9171536436 7892590360" _
& "0113305305 4882046652 1384146951 9415116094 3305727036 5759591953 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724" _
& "8912279381 8301194912 9833673362 4406566430 8602139494 6395224737 1907021798 6094370277 0539217176 2931767523 8467481846 7669405132" _
& "0005681271 4526356082 7785771342 7577896091 7363717872 1468440901 2249534301 4654958537 1050792279 6892589235 4201995611 2129021960" _
& "8640344181 5981362977 4771309960 5187072113 4999999837 2978049951 0597317328 1609631859 5024459455 3469083026 4252230825 3344685035"
s2 = DeleteSpace(s1)
jspaizh = Left(s2, Val(sd) + 1)

End Function

Public Function DeleteSpace(Tmp As String) As String
   Dim Inst As Integer
   Do
       Tmp = Replace(Tmp, " ", "")
       DoEvents
       Inst = InStr(Tmp, " ")
   Loop While Inst > 0
   DeleteSpace = Tmp
End Function

Private Function jcjs(sa As String) As String

Dim s
s = 1
For I = 1 To sa
s = MbC(Trim(s), Val(I))
Next
jcjs = s



   
End Function

这两个程序可能有用发一下。

ysr

Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If



   
End Function

这个程序可能有用，传一下，都是以前编的。

ysr

Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc3 = "-" & jb
Else
If Val(fh2) < 0 Then
mpc3 = "-" & jb
Else
mpc3 = jb
End If
End If
End If
End If

End Function

Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja


End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc2 = "-" & jb
Else
If Val(fh2) <= 0 Then
mpc2 = jb
Else
mpc2 = "-" & jb
End If
End If
End If
End If

End Function

Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = 0 Or sb = 0 Then
mbc2 = 0
Else


ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If




End Function

ysr

Private Function fhys(sa As String) As String

If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
End If

   
End Function

ysr

Private Function qdfh(sa As String) As String

If InStr(sa, "-") > 0 Then
qdfh = Mid(sa, 2)
Else
If InStr(sa, "+") > 0 Then
qdfh = Mid(sa, 2)
Else
qdfh = sa
End If
End If


   
End Function

ysr

4999999999999999999999999有25位，用时2.197266E-02秒（这个是我的程序计算的60度的余弦值点后25位，可以用于8位一组的利用快速傅里叶变换的乘法程序，50位的就慢些（可用于16位一组的快速乘法），大约0.15秒，150位的（可用于48位一组的快速乘法）更慢大约4.5秒，要想提高计算正弦余弦的速度看来必须改变算法，可以用到秦九韶算法，用到秦九韶多项式，就是把泰勒级数展开式写成秦九韶多项式，就是有多层括号的多项式，由内向外逐层计算，迭代几次就可以达到精度，希望老师指点一下，有空再弄吧！欢迎指导，欢迎提供更好的方法。）

50000000000000000000000000000000000000000000000001有50位，用时0.1572266秒

500000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000有150位，用时4.741211秒

有空试试8位一组的就是把8位当作1位数，看看能不能提高速度（因为要多次用到正弦余弦值，前面的速度还是不够快，得不偿失的话，速度不一定能快），有空再试试吧。
祝各位老师晚安！！

ysr

秦九韶算法：把一个一元n次多项式改写成秦九韶多项式，求多项式的值时，首先计算最内层括号内一次多项式的值，然后由内向外逐层计算一次多项式的值，这样，求n次多项式f(x)的值就转化为求n个一次多项式的值。上述方法称为秦九韶算法。直到今天，这种算法仍是多项式求值比较先进的算法。

可见老祖宗留下的方法还是好的，珍贵的有用的，在当时是先进的！

反复提取公因子后，原函数可以写成秦九韶多项式，可以用来加快计算速度。

对于一个n次的多项式函数，用常规方法（用重复乘法计算幂，再把各项相加）计算出结果最多需要n次加法和[n*(n+1)]/2次乘法。若用x迭代的方法计算幂则需要n次加法和2n+1次乘法。如果计算中的数值数据是以字节方式储存的，那么常规方法约需要x占用的字节的2n倍空间。

而使用秦九韶算法时，至多只需作n次加法和n次乘法，最多需要x占用的字节的n倍空间。

该算法看似简单，其最大的意义在于将求n次多项式的值转化为求n个一次多项式的值。在人工计算时，利用秦九韶算法和其中的系数表可以大幅简化运算；对于计算机程序算法而言，加法比乘法的计算效率要高很多，因此该算法仍有极大的意义，用于减少CPU运算时间。

该算法看似简单，其最大的意义在于将求n次多项式的值转化为求n个一次多项式的值。在人工计算时，利用秦九韶算法和其中的系数表可以大幅简化运算；对于计算机程序算法而言，加法比乘法的计算效率要高很多，因此该算法仍有极大的意义，对于计算机来说，做一次乘法运算所用的时间比作一次加法运算要长得多，所以此算法极大地缩短了CPU运算时间。

ysr

Private Function jsfanzq(sa As String, sd As String) As String
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 0 Then
jsfanzq = zhengchuqy(MCC1(jspaizh(sd), Val(2)))
Else
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
sa1 = zhengchuqy(MCC1(1 & String(2 * Val(sd), "0"), qdfh(Trim(sa))))
Else
sa1 = qdfh(Trim(sa))
End If


Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa1), Trim(sa1), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), Val(s3))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), Val(s3))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)


Loop

js4 = mbc2(Trim(sa1), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
fsa = fhys(Trim(sa))
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsfanzq = tjfh(mpc2(jspaizh(sd), Trim(js4)), Val(fsa))
Else
  jsfanzq = tjfh(Trim(js4), Val(fsa))
  End If
End If
End Function
'计算高精度反正切值的程序