| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 7298 人关注过本帖
标题:用牛顿迭代法做的快速除法程序
只看楼主 加入收藏
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:809
专家分:77
注 册:2020-2-10
收藏
得分:0 
回复 49楼 wds1
我的比较大小的编程思想就是这样的,只不过,D1>D2和D1<D2无法直接比较,需要一段一段比较的,从高位段到低位段的,程序没有您写的这么简单。

需要学习和消化。
2021-05-10 21:22
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:809
专家分:77
注 册:2020-2-10
收藏
得分:0 
Option Explicit
Private Sub Form_Load()
  Call init
  Text1(0).Text = "1234567812345678"
  Text1(1).Text = "1234567812345678"
 End Sub

Private Sub Command1_Click(Index As Integer)
 'Open "d:\1.txt" For Output As #1
  Dim D1$, D2$, i&, tt
  For i = 0 To 2
    Text1(i).Text = Trim(Text1(i).Text)
    Text1(i).Text = Replace(Text1(i).Text, vbCrLf, "")
  Next
  D1 = Text1(0).Text
  D2 = Text1(1).Text
  Call big32(D1, Big1) '字符串转数组【4位一个分组,数组首位的长度,减少运算是数组长度判断】
  Call big32(D2, Big2)
  Label1.Caption = Format(Now(), "hh:mm:ss")
  tt = Timer
  Select Case Index
  Case 0: Call BigAdd(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2)  '【加法】
  Case 1: Call BigSub(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2)  '【减法】
  Case 2: Call BigMult(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2) '【乘法】
  Case 3: Call BIgDiv(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2)  '【除法】
  End Select
  tt = Timer - tt
  Label2.Caption = Format(tt, "0.0000")
 ' Close #1
End Sub

Private Sub init()
  Dim i&
  For i = 0 To 2: Text1(i).Width = Screen.Width - 100: Next
  ReDim C2D(3, 48 To 57) As Double '字符映射引用,减少字符转数字时间
  For i = 0 To 9: C2D(0, i + 48) = i: Next
  For i = 0 To 9: C2D(1, i + 48) = i * 10: Next
  For i = 0 To 9: C2D(2, i + 48) = i * 100: Next
  For i = 0 To 9: C2D(3, i + 48) = i * 1000: Next
End Sub

Option Explicit
'//////////////////////////////////////////////////////////////////////////////
'//
'//      公有声明
'//
'//////////////////////////////////////////////////////////////////////////////
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
'------------------------------------------------------------------------------
'       公有变量
'------------------------------------------------------------------------------
Public C2D, Big1() As Double, Big2() As Double, p1p2() As Double
'=========================================================================
'求(a,b)最大值
'=========================================================================
Public Function max(a, b) As Variant
  max = IIf(a >= b, a, b)
End Function
'=========================================================================
'=======================================================================================
'【大数加法】【4字节】-模拟竖式加法【输入:数组、输出:长度+数组】【调用函数:Nzero】
'========================================================================================
Public Function BigAdd(D1() As Double, D2() As Double, sum() As Double)
  Dim i&, j&
  i = max(D1(0), D2(0))  '数组最大长度
  j = Abs(D1(0) - D2(0)) '数组长度差
  ReDim sum(i + 1)
  sum(0) = i + 1
  If i >= D1(0) Then '【A>=B】利用一次判断,减少不同位数的加法运算
    For i = 1 To j: sum(i + 1) = D1(i): Next '【差异部分】【直接赋值】
    For i = 1 To D2(0)
      sum(i + j + 1) = D1(i + j) + D2(i)     '【相同部分】【求和】
      If sum(i + j + 1) > 10000 Then         '【进位处理】
        sum(i + j) = sum(i + j) + 1
        sum(i + j + 1) = sum(i + j + 1) - 10000
      End If
    Next
  Else '【A<B】
    For i = 1 To j: sum(i + 1) = D2(i): Next '大数末位对齐
    For i = 1 To D1(0)
      sum(i + j + 1) = D2(i + j) + D1(i)
      If sum(i + j + 1) > 10000 Then  '进位处理
      sum(i + j) = sum(i + j) + 1
      sum(i + j + 1) = sum(i + j + 1) - 10000
      End If
    Next
  End If
  If sum(1) = 0 Then Call NZero(sum) '【去前缀0】
End Function
'=======================================================================================
'【大数加法】【4字节】-模拟竖式加法【输入:数组、输出:长度+数组】【调用函数:nzero】
'========================================================================================
Public Function BigSub(D1() As Double, D2() As Double, sum() As Double)
  Dim i&, j&
  i = max(D1(0), D2(0))  '数组最大长度
  j = Abs(D1(0) - D2(0)) '数组长度差
  ReDim sum(i)
  sum(0) = i
  If i >= D1(0) Then
    For i = 1 To j: sum(i) = D1(i): Next  '【差异部分】【直接赋值】
    For i = 1 To D2(0)
      sum(i + j) = D1(i + j) - D2(i)     '【相同部分】【求差】
      If sum(i + j) < 0 Then              '进位处理
        sum(i + j - 1) = sum(i + j - 1) - 1
        sum(i + j) = sum(i + j) + 10000
      End If
    Next
  Else
    MsgBox "被减数溢出": End
  End If
  If sum(1) = 0 Then Call NZero(sum)
End Function
'======================================================================================
'【大数乘法】【4字节】-模拟竖式加法【输入:数组、输出:长度+数组】【调用函数:nzero】
'======================================================================================
Public Function BigMult(D1() As Double, D2() As Double, p1p2() As Double)
  Dim d3#, i&, j&, maxc&
  maxc = D1(0) + D2(0)
  ReDim p1p2(maxc + 1) '保存积
  p1p2(0) = maxc
  For i = 1 To D1(0)    '不考虑进位的竖式乘法运算
    For j = 1 To D2(0)  'p1p2位D1的i位与D2的j位相乘结果
      p1p2(i + j) = p1p2(i + j) + D1(i) * D2(j)
    Next
  Next
  For i = maxc To 2 Step -1  '单独处理进位,减少每次加法的进位词素
    If p1p2(i) >= 10000 Then
      d3 = Int(p1p2(i) / 10000)
      p1p2(i - 1) = p1p2(i - 1) + d3
      p1p2(i) = p1p2(i) - d3 * 10000
    End If
  Next
  If p1p2(1) = 0 Then Call NZero(p1p2)
End Function
'======================================================================================================
'【大数除法】【4字节数组】-补位、试商除法【输入:数组、输出:数组】【调用函数:bigmult、bigsub、bigcomp】
'======================================================================================================
Public Function BIgDiv(D1() As Double, D2() As Double, p1p2() As Double)
  Dim i&, k&, j&, r0, top(1) As Double, temp() As Double, len1&, num1() As Double
  ReDim r0(D1(0) - D2(0) + 1) '除法的商(临时)
  ReDim p1p2(D1(0) - D2(0) + 1)       '除法的商(结果)
  p1p2(0) = D1(0) - D2(0) + 1
  top(0) = 1 '保留商
  len1 = 0   '缩位控制
  If D1(0) > D2(0) Then '【同位减法】位数不等,D2补位,首位小少补1位
    len1 = IIf(D1(1) < D2(1), D1(0) - D2(0) - 1, D1(0) - D2(0))
    ReDim Preserve D2(D2(0) + len1) '补位,扩大10^len1倍,d1>=d2
    D2(0) = D2(0) + len1 '数组首位:数组数据长度
  End If
st1:
   k = BigComp(D1, D2) '比较数组大小
   If D1(1) < 0 Then End
   If k = 0 Then r0(len1) = r0(len1) + 1: GoTo st2 '【N倍整除】-【返回】
   If k >= 1 Then '【够除】【k=1:位数不等】【k=2:位数相等】
     If k = 1 Then top(1) = Int((D1(1) * 10000 + D1(2)) / (D2(1) + 1)) '试商结果0-9999
     If k = 2 Then top(1) = Int(D1(1) / (D2(1) + 1)) ''试商结果0-9999
     If top(1) > 1 Then '【试商后结果:2-9999】【先乘,后减】
       Call BigMult(D2, top, temp)
       Call BigSub(D1, temp, num1)
       r0(len1) = r0(len1) + top(1)
     Else '【试商后结果:0-1】【直接减】
       Call BigSub(D1, D2, num1)
       r0(len1) = r0(len1) + 1
     End If
     ReDim D1(UBound(num1))
     D1 = num1 '剩余数据
     GoTo st1
   Else '【不够减】【len1<>0,缩位】【len1=0,结束】
     If len1 >= 1 Then '若扩位,则缩位
       len1 = len1 - 1: D2(0) = D2(0) - 1: ReDim Preserve D2(D2(0)): GoTo st1 '缩少1字节扩位
     End If
st2:
    For j = UBound(r0) To 0 Step -1 '倒序商数
       If r0(j) <> 0 Then Exit For
    Next
    p1p2(0) = j + 1
    For i = 0 To j: p1p2(i + 1) = r0(j - i): Next
  End If
End Function
'===============================================================================
'【10进制串->数组】【输入:字符串】【输出:长度+4字节数组】【高位在前)】
'调用函数:C2D数组映射、copymemory 内存数据复制
'===============================================================================
Public Function big32(msg As String, arr() As Double)
  Dim i&, top_len&, dest_len&, src_len&, bz&, Count&, temp() As Integer
  src_len = Len(msg)                     '输入字符串长度
  dest_len = Int((Len(msg) - 1) / 4) + 1 '目的分组长度【4位上取整】
  top_len = Len(msg) Mod 4               '头部分组长度(1-3字节)
  ReDim arr(dest_len)     '目的数组数据
  arr(0) = dest_len       '目的数组长度
  ReDim temp(src_len - 1) '字符串缓冲数组
  i = StrPtr(msg)         '字符串指针地址
  CopyMemory ByVal VarPtr(temp(0)), ByVal i, src_len * 2 '读取字符串内容到内存
  Count = 0
  For i = 1 To top_len     '【非4位整数的头字节】1-3字节
    If i = 1 Then Count = Count + 1 '只加一次
    arr(Count) = arr(Count) + C2D(top_len - i, temp(i - 1))
  Next
  For i = top_len + 1 To src_len  '【4位字节整数】
    bz = (i - top_len - 1) Mod 4
    If bz = 0 Then Count = Count + 1
    arr(Count) = arr(Count) + C2D(3 - bz, temp(i - 1))
  Next
End Function
'=======================================================================
'【数组比较】【输入:数组、输出:1:长度大 2:长度相等大于 0:等于 -1:小于】
'=======================================================================
Public Function BigComp(num1() As Double, num2() As Double) As Long
  Dim i&
  If num1(0) > num2(0) Then BigComp = 1: Exit Function  '长度大,大数
  If num1(0) < num2(0) Then BigComp = -1: Exit Function '长度小,小数
  For i = 1 To num1(0) '逐位比较
    If num1(i) > num2(i) Then BigComp = 2: Exit Function  '长度相等,大数
    If num1(i) < num2(i) Then BigComp = -1: Exit Function '长度相等,小数
  Next
  If i > num1(0) Then BigComp = 0 '数组相等
End Function
'=======================================================================
'【清数组前置0】【输入:数组、输出:去前缀0数组】
'=======================================================================
Public Sub NZero(Soure() As Double) '去除数组前置0
  Dim i&, j&
  For i = 1 To Soure(0)
    If Soure(i) <> 0 Then Exit For
  Next
  If i > Soure(0) Then Soure(0) = 1: Soure(1) = 0: Exit Sub
  If i > 1 Then
    For j = i To Soure(0): Soure(j - i + 1) = Soure(j): Next
    Soure(0) = Soure(0) - i + 1
  End If
End Sub
'=========================================================================
'【数组->10进制串】【输入:byte数组、输出:字符串】
'=========================================================================
Public Function B2D(byte1) As String
  Dim i&
  B2D = Trim(Str(byte1(1)))
  For i = 2 To byte1(0)
    B2D = B2D & Format(byte1(i), "0000")
  Next
End Function

'这个代码无法运行,启动后点击+-*或者/按钮,都是提示变量Big1没有定义,不知道咋回事,咋弄呢?
2021-05-10 22:18
wds1
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:49
帖 子:393
专家分:2025
注 册:2016-3-10
收藏
得分:0 
在模块int32.bas中已经定义了公共变量,不应该报没定义。
Public C2D, Big1() As Double, Big2() As Double, p1p2() As Double




2021-05-11 07:57
ysr2857
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:34
帖 子:809
专家分:77
注 册:2020-2-10
收藏
得分:0 
回复 53楼 wds1
感谢老师不厌其烦的指导!不知道咋回事,我再学习和消化一下!
2021-05-11 10:57
快速回复:用牛顿迭代法做的快速除法程序
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

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