[程序]大整数的开平方程序

ysr

[这个贴子最后由ysr在 2012/08/14 08:50pm 第 1 次编辑] 感谢各位老师和朋友的无私帮助和支持，“雄关漫道真如铁，而今迈步从头越！”终于搞出了大整数的开平方程序，如下为代码，输入非负整数，结果输出方根的整数部分和余数，“/”号后面的为余数： Private Sub Command1_Click() D1 = Text1.Text jcc = MBBC(Text1.Text) If InStr(jcc, "/") = 0 Then Text2.Text = "0" Text3.Text = MBBC(Text1.Text) Else Text2.Text = Mid(jcc, InStr(jcc, "/")) Text3.Text = Left(jcc, InStr(jcc, "/") - 1) End If End Sub Public Function MBBC(D1 As String) As String ';kai pingfang If Len(D1) < 10 Then jss = Int(Sqr(D1)) JW = Val(D1) - (jss) ^ 2 If JW = 0 Then MBBC = jss Else MBBC = jss & "/" & JW End If Else Dim X ';shuju changdu X = Len(D1) \ 4 D2 = String(4 - Len(D1) + 4 * X, "0") & D1 Dim A() As String ReDim A(4 To 4 * X + 4) Dim B() As String ReDim B(2 To 2 * X) Dim I, J, js For I = 4 To 4 * X + 4 Step 4 A(I) = Mid(D2, I - 3, 4) js = Int(Sqr(Val(A(4) & A(8)))) JW = Val(A(4) & A(8)) - (js) ^ 2 Next J = 4 Do While J <= 2 * X jws = MPC1(JW & "0000", A(2 * J + 4)) If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then B(J) = "00" Else jwc = Left(jws, 4) \ Left(MbC(Trim(js), 200), 2) If Len(jwc) > 2 Then B(J) = 99 Else B(J) = jwc End If Do While MBJC(Trim(jws), MbC(MPC1(B(J), MbC(Trim(js), 200)), B(J))) = -1 B(J) = B(J) - 1 Loop End If JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(J)), B(J))) js = MPC1(MbC(Trim(js), 100), Trim(B(J))) J = J + 2 If JW = 0 Then MBBC = js Else MBBC = js & "/" & JW End If Loop End If End Function Public Function MBJC(D1 As String, D2 As String) As String ';bijiao If Len(D1) > Len(D2) Then MBJC = 1 Else If Len(D1) < Len(D2) Then MBJC = -1 Else If Len(D1) = Len(D2) Then Dim X, Y X = Len(D1) \ 4: Y = Len(D2) \ 4 Dim A() As String, B() As String ReDim A(4 To 4 * X + 4) ReDim B(4 To 4 * Y + 4) If Val(Left(D1, Len(D1) - 4 * X)) > Val(Left(D2, Len(D2) - 4 * Y)) Then MBJC = 1 Else If Val(Left(D1, Len(D1) - 4 * X)) < Val(Left(D2, Len(D2) - 4 * Y)) Then MBJC = -1 Else For I = 4 To 4 * X Step 4 A(I) = Mid(D1, Len(D1) - I + 1, 4) B(I) = Mid(D2, Len(D2) - I + 1, 4) Next J = 4 * X Do While A(J) = B(J) And J >= 8 J = J - 4 Loop If Val(A(J)) - Val(B(J)) > 0 Then MBJC = 1 Else If Val(A(J)) - Val(B(J)) < 0 Then MBJC = -1 Else MBJC = 0 End If End If End If End If End If End If End If End Function Public Function MbC(D1 As String, D2 As String) As String ';乘法 Dim X, Y ';两数长度 X = Len(D1): Y = Len(D2) Dim A() As Integer ReDim A(1 To X + Y, 1 To Y) Dim I, J, C1, C2, CJ, JW For J = Y To 1 Step -1 ';D2 JW = 0 ';进位清0 C2 = Mid$(D2, J, 1) ';每位数 For I = X To 1 Step -1 ';D1 C1 = Mid$(D1, I, 1) ';每位数 CJ = C1 * C2 + JW ';计算乘积 C = I + J: r = Y + 1 - J A(C, r) = CJ Mod 10 ';本位 JW = CJ \ 10 ';进位 Next A(C - 1, r) = JW Next Dim B() As Integer ReDim B(1 To X + Y) JW = 0 For I = X + Y To 1 Step -1 Bit = JW For J = 1 To Y Bit = Bit + A(I, J) Next B(I) = Bit Mod 10 JW = Bit \ 10 Next If B(1) > 0 Then MbC = MbC & B(1) Else MbC = MbC End If For I = 2 To X + Y MbC = MbC & B(I) Next End Function Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi Dim X, Y ';两数长度 If Len(D1) >= Len(D2) Then D4 = String(Len(D1) - Len(D2), "0") & D2 D3 = D1 Else D4 = D2 D3 = String(Len(D2) - Len(D1), "0") & D1 End If X = Len(D3): Y = Len(D4) Dim A() As Integer, B1() As Integer, C1() As Integer, E1() As Integer ReDim A(1 To X) ReDim B1(1 To Y) ReDim C1(1 To X) ReDim E1(1 To X) Dim I, J, C2, CJ, JW For J = Y To 1 Step -1 ';D2 JW = 1 ';yu jie weichuzhi B1(J) = Mid$(D4, J, 1) ';每位数 For I = X To 1 Step -1 ';D1 A(I) = Mid$(D3, I, 1) ';每位数 C1(I) = 10 + A(I) - B1(I) - 1 + JW ';计算jia JW = C1(I) \ 10 E1(I) = C1(I) Mod 10 Next Next For r = 1 To X MPC = MPC & E1(r) For I = 1 To Len(MPC) If Not Mid(MPC, I, 1) = "0" Then Exit For End If Next strtmp = Mid(MPC, I) If Len(strtmp) = 0 Then MPC = "0" Else MPC = strtmp End If Next 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 Public Function MPC1(D1 As String, D2 As String) As String ';jiafa Dim X, Y ';两数长度 If Len(D1) >= Len(D2) Then D4 = String(Len(D1) - Len(D2), "0") & D2 D3 = D1 Else D4 = D2 D3 = String(Len(D2) - Len(D1), "0") & D1 End If X = Len(D3): Y = Len(D4) Dim A() As Integer, B1() As Integer, C1() As Integer, E1() As Integer ReDim A(1 To X) ReDim B1(1 To Y) ReDim C1(1 To X) ReDim E1(1 To X) Dim I, J, C2, CJ, JW For J = Y To 1 Step -1 ';D2 JW = 0 ';进位清0 B1(J) = Mid$(D4, J, 1) ';每位数 For I = X To 1 Step -1 ';D1 A(I) = Mid$(D3, I, 1) ';每位数 C1(I) = A(I) + B1(I) + JW ';计算jia JW = C1(I) \ 10 E1(I) = C1(I) Mod 10 Next Next For r = 1 To X If JW = 0 Then MPC1 = MPC1 & E1(r) Else jc = jc & E1(r) MPC1 = JW & jc End If Next End Function Private Sub Command2_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" End Sub 输入：1153103961384478448404925715924378885327554202134226047348028294505040734467336124656452525279797166397567399850900985140768071391715673547272680475009022731025540851253778962537039004520776708021234701340368231774597408929744933116431873027001298810225982471847， 余数：/35665105349110423671377431203372583428527991869802363067968261122040651857913730532604241494396804996920297240334088188848351493271， 方根：33957384489746533604491714354510448378792539897963554793812642588357494533321229873298229824105433935337611283663042668907175598524， 输入：39062500000000， 余数：0， 方根：6250000，

ysr

263位的运行时间约10秒钟，

ysr

要计算小数点后多少位，可以先移动小数点，要移偶数位（或补0），结果在移位，移动位数是前述偶数除以2，方向相反，如求根号3，精确到点后100位，则先在3后补200个0，结果再后面100位前加小数点，验证：
输入：300000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000，
余数：/26197663862374659372917854782608965848535274460184337445252387387339844612780314149882927155177108464，
方根：17320508075688772935274463415058723669428052538103806280558069794519330169088000370811461867572485756，
所以，根号3=1.7320508075688772935274463415058723669428052538103806280558069794519330169088000370811461867572485756，

天山草

下面引用由ysr在 2012/07/20 09:33pm 发表的内容：
要计算小数点后多少位，可以先移动小数点，要移偶数位（或补0），结果在移位，移动位数是前述偶数除以2，方向相反，如求根号3，精确到点后100位，则先在3后补200个0，结果再后面100位前加小数点，

原始数据是否需要后面补零，应是程序自动来判定并自动完成，不需要人工进行。这样才好。

ysr

是的，这是专为算整数部分设计的，需要计算小数点后面的数据的话，要改程序，让程序自动完成，否则只好手工做了，这是个可调用程序，不必改，可以在主程序中完成补0或移动小数点。

ysr

顶一下，欢迎试用