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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 8 339 fois - Téléchargée 30 fois

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

Ajouter un commentaire

Commentaires

C'est un programme fort intéressant et qui me rend bien service.Merci à vous.
Messages postés
51
Date d'inscription
samedi 21 octobre 2000
Statut
Membre
Dernière intervention
10 octobre 2011

Je suis également en recherche sur ce thème et la seule voie royale est l'exploitation des libraires spécifiques écrites en C
car réécrire les différents types d'opérations en gestion de blocs sous VB donne un résultat rapidement pitoyable
(notamment dès qu'on dépasse les nombres en 256bits)

GMP (libgmp-3.dll) est donnée pour la plus rapide (loin devant bigint, bcmath etc) et semble la plus complète avec ses presque 400 fonctions
mais je ne parviens pas à l'exploiter, d'autant que la littérature sur la toile concernant ce sujet
est des plus ligth surtout pour une utilisation VB. 8(
De plus l'avantage de cette librairie est d'être supportée par php ce qui permet de développer des procédures clien-serveur communes.

Si quelqu'un avait une expérience dans le domaine, il serait le bienvenu.
Messages postés
248
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
19 décembre 2008

Cette source est abandonnée ? Je recherche une bonne source pour travailler sur des entiers long, très long... Et celle-ci est la meilleur base que j'ai trouvé.

Question optimisation il faut tout refaire à neuf, puisque utiliser les strings c'est un gouffre à performances.

Quelqu'un connais une meilleur source ... en VB non .NET ?
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
Bonsoir,

J'ai pas tout testé, mais mes algos sur les grands nombres ne semble plus rapides... Néanmoins, il y a dans ta programmation des idées très intéressantes... JE note dans la fonction Comparer le fait d'équilibrer la longueur des chaînes avant la comparaison... et si les nbs à comparer ne sont pas signé, alors on peut encore simplifier la fonction, en utilisant StrComp, il me semble... avec :

=

Function Comparer(x1 As String, x2 As String) As Integer
' comparaison = -1 , 0 ou 1 de x1 par rapport à x2
'! avec x1 et x2 positifs !

Comparer = StrComp(String$(Len(x2), "0") & x1, String$(Len(x1), "0") & x2, vbTextCompare)

End Function

=

Pour augementer la rapidité, environ de 20%, dans toutes les sub, il suffit d'utiliser la Right$, Mid$, String$ ... , au lieu de leur équivalent sans $ !

JE pense qu'il y a encore beaucoup d'endroits où l'on peut optimiser... je regarderais un peu plus tard ton code plus précisement...

Juste une petite remarque, dans PasdeZero, j'aurais bien vu une boucle, plutôt que toutes ces lignes...

Par exemple :

=

Function PasDeZero(x0 As String) As String
Dim uv As Integer
uv = Len(x0)

for t=1 to 9
If InStr(1, x0, str$(t)) > 0 And InStr(1, x0, str$(t)) < uv Then uv = InStr(1, x0, str$(t))
next t

PasDeZero = Right(x0, (Len(x0) - uv) + 1)
End Function

=

J'ai pas testé, mais cela devrait marcher...

Amicalement,
Us.
Messages postés
2
Date d'inscription
dimanche 2 juillet 2000
Statut
Membre
Dernière intervention
24 août 2005

Merci GOTH: je vais essayer la méthode karatsuba quand je l'aurai assimilée (je ne suis pas un fan des formules sans exemples concrets). Je ne suis pas certain que l'économie des multiplications par l'augmentation des additions et soustractions soit un plus, mais je vais y réfléchir.

BOAG: comment procèdes-tu pour générer les images ? Je cherche évidemment un moyen de représentation graphique permettant de déduire les facteurs d'un nombre composé et cela m'intéresse.
Afficher les 7 commentaires

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.