supplement.bas

一个VB小程序,能够进行大数的计算,可以作为学习的参考

Attribute VB_Name = "SupplInt"
Attribute VB_Description = "Supplement to bignumVB.dll, a Visual Basic library for large-integer arithmetic."
'Author : Sjoerd.J.Schaper - [e-mail]
'URL    : http://largeint.sourceforge.net/index.html
'Date   : 12-27-2004
'Code   : Visual Basic for Windows 5.0
Option Explicit
Public ErrSw As Boolean '              error switch
Public i(9) As Long '                  10 pointers
Public Lft As Boolean  '               lift switch
Public St(3) As String '               stack

Sub Bezout(a As Long, b As Long, c As Long)
Dim a1 As Integer, b1 As Integer, d As Integer, g As String
Dim r As Boolean, s As Boolean, sw As Boolean
  a1 = 3: b1 = 4: d = 5
  '
  r = Isf(a, 0)
  s = Isf(b, 0)
  If r Or s Then
    If r And s Then
      Data = " division by zero"
      ErrSw = -1: Exit Sub
    End If
    If r Then
      Chs b
      Letf i(a1), 0: Divd c, b, i(b1) 'y = c / -b
    Else
      Letf i(b1), 0: Divd c, a, i(a1) 'x = c / a
    End If
    sw = Isf(c, 0): r = 0
  Else
    Copyf a, i(a1) '                   ax - by = c
    Euclid i(a1), b, i(d)
    If Not Isf(i(d), 1) Then  '        gcd(a,b) > 1
      Divd a, i(d), t0: Swp a, t0
    End If
    Mult a, i(a1), t0 '               (a * a^-1
    Swp a, t0: Dcr t0, 1 '                      - 1)
    Divd t0, b, i(b1) '        b^-1 =                / b
    '
    r = Isf(c, 0): sw = -1 '          If c = gcd(a,b)
    s = Cmp(c, i(d)) = 0 '             x = a^ -1, y = b^ -1
    If Not (r Or s) Then
      Divd c, i(d), t0: Swp c, t0
      If Isf(t0, 0) Then
        Mult i(b1), c, t0 '            b^ -1 * c
        Divd i(b1), a, t0 '        y =           Mod a
        Mult b, i(b1), t0: Add b, c '  b * y + c
        Divd b, a, i(a1) '         x =           / a
      Else
        sw = 0
      End If
    End If
  End If
  '
  If sw Then
    Swp i(a1), b: Swp i(b1), c
    If r Then
      Data = " zero c is set to gcd(a,b) = "
      Printn i(d), "", "", 1
    End If
  Else
    Data = " illegal argument c"
    ErrSw = -1
  End If
End Sub

Sub Bin(a As Long)
Dim g As String, t As Long
  '
  If Isf(a, 0) Then
    g = "0": t = 1
  Else
    Copyf a, t0
    g = "": t = 0
    Do: t = t + 1
      If -(Gete(t0, 0) And 1) Then
        g = "1" + g
      Else
        g = "0" + g
      End If
      Rsft t0, 1 '                     repeated shr
      If (t And 7) = 0 Then
        Slate.Box.Text = g: g = " " + g
        DoEvents: If Key Then Exit Sub
      End If
    Loop Until Isf(t0, 0)
    g = LTrim$(g)
    If Gets(a) = -1 Then g = "-" + g
  End If
  Data = g & "  [" & t & "]"
End Sub

Sub Binomial(N1 As String, N2 As String)
Dim a As Long, b As Long, c As Long
Dim r As Integer, s As Integer
  '
  r = Len(N1) > 9
  s = Len(N2) > 9
  If r Or s Then
    Data = " overflow"
    ErrSw = -1: Exit Sub
  End If
  '
  a = Val(N1): b = Val(N2)
  r = a < 0: a = Abs(a)
  s = b < 0 Or b > a
  If s Then
    Data = " illegal argument k"
    ErrSw = -1: Exit Sub
  ElseIf r Then
    a = a + b - 1
  End If
  If b > a \ 2 Then b = a - b
  Letf i(0), 1
  Letf i(1), a
  Letf t1, 1 '                        (a, b + 1) = (a, b) * (a - b) / (b + 1)
  For c = 1 To b
    Mult i(0), i(1), t0
    Divd i(0), t1, t0: Swp i(0), t0
    Dcr i(1), 1: Inc t1, 1
    DoEvents: If Key Then Exit Sub
  Next c
  If r Then
    If -(b And 1) Then Sets i(0), -1
  End If
End Sub

Sub Chinese(a As Long, m As Long, b As Long, N As Long)
Dim d As Integer, g As String, mi As Integer
Dim r As Integer, s As Integer
  mi = 4: d = 5
  '
  r = Isf(m, 0)
  s = Isf(N, 0)
  If r Or s Then
     Data = " zero modulus"
     ErrSw = -1
  Else
     Sets m, 1: Sets N, 1 '            x = a (mod m)
     Copyf m, i(mi) '                  x = b (mod n)
     Euclid i(mi), N, i(d)
     Subt b, a '                      (b - a)
     Divd b, i(d), t0 '                       / gcd(m,n)
     If Not Isf(b, 0) Then
       Data = " modulus = 0"
       ErrSw = -1: Exit Sub
     End If
     Mult t0, i(mi), t1 '                                * m^-1 Mod n
     Mult t0, m, t1 '                                                 * m
     Add a, t0 '             a:= a +
     '
     Mult m, N, t0 '                   lcm(m,n)
     Moddiv a, m '           a:= a Mod
     Swp a, b: Swp m, N
   End If
End Sub

Sub Cornacchia(N As Long)
Dim d As Integer, g As String, q As Integer, r As Integer
Dim sw As Boolean, t As Integer, x As Integer
  d = 1: q = 2: r = 3: x = 4
  '
  If (Gete(N, 0) And 3) = 3 Then Exit Sub
  Printn N, "", "", 0
  If Getl(N) = 1 Then
    g = Data + " is prime"
  Else
    g = Data + " is probably prime"
  End If
  g = g + dbCrLf
  '
  Copyf N, i(d): Dcr i(d), 1
  If Isf(N, 2) Then
    Letf i(d), 1
  Else
    Ressol i(d), N '                   solve r^ 2 = -1 (mod N)
  End If
  Isqrt N, i(x): Copyf N, i(r) '       Cornacchia's CF algorithm computes
  t = 0: sw = -1: Data = "[" '         the quadratic representation of N
  Do
    t = t + 1
    Divd i(r), i(d), i(q)
    Printn i(q), "", ",", 1 '          partial quotients
    If sw Then
      If Cmp(i(r), i(x)) < 1 Then '    remainder <= Isqrt(N)
        Copyf i(r), i(x): sw = 0 '     store x, skip search
      End If
    End If
    Swp i(r), i(d)
  Loop Until Isf(i(d), 0)
  g = g + Left$(Data, Len(Data) - 1) + "]"
  g = g & "  p = " & t & vbCrLf  '     full period
  '
  If Isf(N, 2) Then Letf i(x), 1
  Printn i(x), "", "", 0
  Slate.Stax 0: Lft = -1: Slate.Lift
  St(0) = Data '                       return x in register Y
  g = g + " a in Z[i] = " + Data + " + "
  Squ i(x), i(d): Subt N, i(d)
  Isqrt N, i(x) '                      y = Isqrt(N - x^ 2)
  Printn i(x), "", "", 0
  Slate.InputN.Text = Data '           return y in register X
  If Not Isf(i(x), 1) Then
    g = g + Data + "