Opérations sur de grands entiers naturels (+100 chiffres)

Contenu du snippet

Opérations: ADDITION, SOUSTRACTION, DIVISION, MULTIPLICATION, RACINE ENTIERE, PGCD
Nombres: grands entiers naturels sous forme de chaînes de caractères
+ 2 modules: PasDeZeros (supprime les zéros non significatifs) et Comparer (+ grand, + petit, égal)

Les modules calculent assez vite même s'ils peuvent probablement être améliorés.

Source / Exemple :


Sub PGCD(x1 As String, x2 As String, x3 As String)
  ' calcule le PGCD entre x1 et x2 dans x3
  Dim ax1 As String, ax3 As String
  Dim Resultat As String, Reste As String, aReste As String, Diviseur As String
  ax1 = x1: Diviseur = x2: aReste = x2
  Do
    Call Diviser(ax1, Diviseur, Resultat, Reste)
    If Reste = "0" Then
      x3 = aReste
      Exit Do
    Else
      aReste = Reste
      ax1 = Diviseur
      Diviseur = Reste
    End If
  Loop
End Sub
Sub Ajouter(x1 As String, x2 As String, x3 As String)
  ' x1 + x2 = x3
  Dim i As Integer, Retenue As Integer, n As Integer
  Dim xx1 As String, xx2 As String
  xx1 = x1
  xx2 = x2
  If Len(x1) >= Len(x2) Then
    xx2 = Right(String(Len(xx1), "0") & xx2, Len(xx1))
  Else
    xx1 = Right(String(Len(xx2), "0") & xx1, Len(xx2))
  End If
  x3 = String(Len(xx1) + 1, "0")
  Retenue = 0
  For i = Len(xx1) To 1 Step -1
    n = Val(Mid(xx1, i, 1)) + Val(Mid(xx2, i, 1)) + Retenue
    If n > 9 Then
      n = n - 10
      Retenue = 1
    Else
      Retenue = 0
    End If
    Mid(x3, i + 1, 1) = CStr(n)
  Next i
  Mid(x3, 1, 1) = CStr(Retenue)
  x3 = PasDeZero(x3)
End Sub
Sub Soustraire(x1 As String, x2 As String, x3 As String)
  ' sous réserve que x1 >= x2, x1 - x2 = x3
  Dim i As Integer, Retenue As Integer, n As Integer, xx2 As String
  xx2 = Right(String(Len(x1), "0") & x2, Len(x1))
  x3 = String(Len(x1), "0")
  For i = Len(x1) To 1 Step -1
    n = Val(Mid(x1, i, 1)) - Val(Mid(xx2, i, 1)) - Retenue
    If n < 0 Then
      n = n + 10
      Retenue = 1
    Else
      Retenue = 0
    End If
    Mid(x3, i, 1) = CStr(n)
  Next i
  x3 = PasDeZero(x3)
End Sub
Sub Multiplier(ax1 As String, ax2 As String, ax3 As String)
  ' ax1 x ax2 = ax3
  Dim g1(5000) As Long, g2(5000) As Long, g3(5000) As Long, i As Integer, j As Integer
  Dim x1 As String, x2 As String, k As Integer
  x1 = String(4 - Len(ax1) Mod 4, "0") & ax1
  x2 = String(4 - Len(ax2) Mod 4, "0") & ax2
  k = (Len(x1) + Len(x2)) \ 4 + 2
  For i = 1 To Len(x1) \ 4
    g1(i) = Val(Mid(x1, Len(x1) - i * 4 + 1, 4))
  Next i
  For i = 1 To Len(x2) \ 4
    g2(i) = Val(Mid(x2, Len(x2) - i * 4 + 1, 4))
  Next i
  For i = 1 To Len(x1) \ 4
    For j = 1 To Len(x2) \ 4
      g3(i + j - 1) = g3(i + j - 1) + g1(i) * g2(j)
      g3(i + j) = g3(i + j) + g3(i + j - 1) \ 10000
      g3(i + j - 1) = g3(i + j - 1) Mod 10000
    Next j
  Next i
  ax3 = ""
  For i = 1 To k
    ax3 = Format(g3(i), "0000") & ax3
  Next i
  j = 1
  Do
    If Mid(ax3, j, 1) <> "0" Then
      ax3 = Right(ax3, Len(ax3) - j + 1)
      Exit Do
    Else
      j = j + 1
      If j > Len(ax3) Then
        ax3 = "0"
        Exit Do
      End If
    End If
  Loop
End Sub
Sub RacineCarree(xx1 As String, xx2 As String)
  ' xx2 = racine entière de xx1
  Dim xx3 As String, xx4 As String, xx5 As String, xx6 As String, xx7 As String
  Dim xx8 As String, axx As String, xx9 As String
  xx3 = "5" & String((Len(xx1) - 1) \ 2, "0")
  If String(Len(xx1) - Len(xx3), "0") & xx3 > xx1 Then xx3 = xx1
  Do
    Call Diviser(xx1, xx3, xx4, xx8)
    Call Soustraire(xx4, "1", xx9)
    If xx3 = xx4 Or axx = xx9 Then
      xx2 = xx3
      Exit Sub
    End If
    Call Ajouter(xx4, xx3, xx6)
    Call Diviser(xx6, "2", xx5, xx7)
    xx3 = xx5
    axx = xx5
    If xx4 = xx8 And xx8 = xx5 Then
      xx2 = xx5
      Exit Sub
    End If
  Loop
End Sub
Sub Diviser(x1 As String, x2 As String, x3 As String, x4 As String)
  ' x1 : x2 = x3 reste x4
  Dim groupe As String, test As String, multi As String
  Dim amulti As String, Reste As String, position As Long
  Dim ux As Integer, u1 As Integer
  
  x3 = ""
  x4 = ""
  Reste = ""
  position = Len(x2)
  ux = Val(Left(x2, 1)) + 1
  If position - 1 > 0 Then
    Reste = Left(x1, position - 1)
  End If
  Do
    groupe = Reste & Mid(x1, position, 1)
    u1 = -1
    If Len(groupe) < Len(x2) Then
      ' numérateur < diviseur
      x3 = x3 & "0"
      Reste = groupe
      position = position + 1
    ElseIf Len(groupe) = Len(x2) Then
      ' longueur numérateur = longueur diviseur
      If groupe < x2 Then
        ' numérateur < diviseur
        x3 = x3 & "0"
        Reste = groupe
        position = position + 1
      ElseIf groupe = x2 Then
        ' égalité numérateur et diviseur
        x3 = x3 & "1"
        Reste = ""
        position = position + 1
      Else
        ' numérateur > diviseur
        u1 = Val(Left(groupe, 1)) \ ux
      End If
    Else
      ' longueur numérateur = longueur diviseur + 1
      ' numérateur > diviseur
      u1 = Val(Left(groupe, 2)) \ ux
    End If
    If u1 <> -1 Then
      If u1 = 0 Then
        ' puisque numérateur > diviseur, mais que u1 peut être nul
        u1 = 1
      End If
      Do
        Call Multiplier(x2, CStr(u1), multi)
        Call Soustraire(groupe, multi, Reste)
        If Comparer(Reste, x2) >= 0 Then
          ' reste > ou = au diviseur
          u1 = u1 + 1
        Else
          x3 = x3 & CStr(u1)
          position = position + 1
          Exit Do
        End If
      Loop
    End If
    If position > Len(x1) Then
      Exit Do
    End If
    If Reste = "0" Then
      Reste = ""
    End If
  Loop
  If Reste = "" Then
    x4 = "0"
  Else
    x4 = PasDeZero(Reste)
  End If
  x3 = PasDeZero(x3)
End Sub
Function PasDeZero(x0 As String) As String
  Dim uv As Integer
  uv = Len(x0)
  If InStr(1, x0, "1") > 0 And InStr(1, x0, "1") < uv Then
    uv = InStr(1, x0, "1")
  End If
  If InStr(1, x0, "2") > 0 And InStr(1, x0, "2") < uv Then
    uv = InStr(1, x0, "2")
  End If
  If InStr(1, x0, "3") > 0 And InStr(1, x0, "3") < uv Then
    uv = InStr(1, x0, "3")
  End If
  If InStr(1, x0, "4") > 0 And InStr(1, x0, "4") < uv Then
    uv = InStr(1, x0, "4")
  End If
  If InStr(1, x0, "5") > 0 And InStr(1, x0, "5") < uv Then
    uv = InStr(1, x0, "5")
  End If
  If InStr(1, x0, "6") > 0 And InStr(1, x0, "6") < uv Then
    uv = InStr(1, x0, "6")
  End If
  If InStr(1, x0, "7") > 0 And InStr(1, x0, "7") < uv Then
    uv = InStr(1, x0, "7")
  End If
  If InStr(1, x0, "8") > 0 And InStr(1, x0, "8") < uv Then
    uv = InStr(1, x0, "8")
  End If
  If InStr(1, x0, "9") > 0 And InStr(1, x0, "9") < uv Then
    uv = InStr(1, x0, "9")
  End If
  PasDeZero = Right(x0, (Len(x0) - uv) + 1)
End Function
Function Comparer(x1 As String, x2 As String) As Integer
  ' comparaison = -1 , 0 ou 1 de x1 par rapport à x2
  Dim xx1 As String, xx2 As String
  xx1 = String(Len(x2), "0") & x1
  xx2 = String(Len(x1), "0") & x2
  If xx1 < xx2 Then
    Comparer = -1
  ElseIf xx1 > xx2 Then
    Comparer = 1
  Else
    Comparer = 0
  End If
End Function

Conclusion :


Programmé en VB5.
Pour tester la rapidité de ces modules, j'ai opéré par opérations en boucles.
Ils me paraissent optimisés, mais si quelqu'un parvient à en réaliser de plus rapides, merci de me le faire savoir car ils sont très utiles dans la recherche de factorisation de grands nombres composés.

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.