Algorithme de division ou de modulo sur grands nombres

**pseudocode** · 03/11/2008, 20h07

Envoyé par Twin111

d'ou d = 10/v[2-1]+1
d = 10/5 -> d = 2
donc u = 2468 et v = 90
Or ici si j'applique ce que je lis : qh = (u[2+2]B + u[2+2-1])/v[2-1]
qh = (8B+6)/9
or dans l'exemple, il fait 2/9
D'ou viens le '2' alors ?

u[] = {8, 6, 4, 2, 0, 0, 0, ...}
v[] = {0, 9, 0, 0, 0, ...}

qh = (u[2+2]*B + u[2+2-1])/v[2-1] = (u[4]*10 + u[3])/v[1] = (0*10 + 2) / 9 = 2/9

**Twin111** · 03/11/2008, 20h08

Je viens de tester ton code, et ce n'est pas ce que je demande, l'algo dont je parle, celui de Knuth je crois, est la pour calculer une division, et de le faire de facon rapide.

Or en testant ton code, je me retrouve avec le resultat de 123456789%6, mais je cherche une methode pour faire 123456789/6 sans passer par de la soustraction successive. Et c'est ce que l'algo de Knuth, poster par Jean Marc.
J'espere qu'il pourra simplement l'ettofer un peu pour moi, car j'avoue etre un peu perdu.

**Twin111** · 03/11/2008, 20h16

Hum ...

Pseudocode, c'est parceque c'est stocké a l'enver ?

Si c'est juste ca ... lol quoi ^^

ps : donc le compteur de lecture par bien de 0, et non de 1

**Twin111** · 03/11/2008, 20h43

Je viens de comprendre, merci beaucoup pour votre aide et patience ^^ Je code ca demain, merci encore

**pseudocode** · 03/11/2008, 23h28

Envoyé par Twin111

Hum ...

Pseudocode, c'est parceque c'est stocké a l'enver ?

Si c'est juste ca ... lol quoi ^^

ps : donc le compteur de lecture par bien de 0, et non de 1

Envoyé par Jean-Marc.Bourguet

On va diviser u = u[n+m-1] ... u[1] u[0]
par v = v[n-1] ... v[1] v[0]

**Twin111** · 06/11/2008, 16h02

Bon, je voulais vous tenir au courant du resultat de la division de grands nombre stocke dans des char * ^^

Et bien nous avons abandone cette algo apres 24h dessus car la fonction 'puissance' qui devais gerer 'BASE^j' etait vraiment trop lente quand 'j' prenais des valeur tres grandes, de l'ordre de '100 000' XD

Merci quand meme !
Par curiosite, vous n'auriez pas une idee d'algo pour la puissance de a^n, avec a et n tres grand et sous forme de char *

**pseudocode** · 06/11/2008, 16h25

c'est quoi le but final de tout ca ?

Parce que des librairies d'arithmétique en précision arbitraire il y en à déjà plein. Inutile de réinventer la roue.

**Zavonen** · 06/11/2008, 17h58

Et oui, c'est quoi le but final???
On est parti sur des modulos, nous voilà sur des puissances.
Comme le dit Pseudocode tous les langages proposent des calculs en précision illimités 'built-in'.
Cependant si pour une raison ou pour une autre vous voulez faire des exos sur ce thème (pourquoi pas).
Sachez que les algos efficaces pour élever un nombre à une puissance donnée disons grande, ne dépendent pas du fait que le nombre lui-même soit grand. Il suffit de chercher à minimiser le nombre des multiplications.
Ainsi un algorithme naïf fera n-1 multiplications pour élever un nombre à une puissance n.
A priori pour élever 3 à la puissance 40. Il faut faire 39 multiplications.
Mais on peut le faire avec seulement 8 multiplications. Le petit programme qui suit montre comment, il est basé sur une décomposition binaire de l'exposant.

Code python :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
#transforme n en base 2
def base2(n):
    if n<2:
        return [n]
    L=base2(n/2)
    L.insert(0,n%2)
    return L
 
# élévation de m à la puissance n
def power(m,n):
    c=0 # compteur de multiplications
    p2=m #variable de boucle contiendra les puissances binaires de m
    e=base2(n) # exposant en base 2
    R=1 # contiendra le résultat final
    for i in range(0,len(e)):
        if e[i]:# si le chiffre binaire de l'exposant est 1
            R*=p2
            c+=1  #et une de plus
        p2*=p2
        c+=1 # et une de plus
    return R,c
 
def main():
    print power(3,40)
    print pow(3,40)

**Jean-Marc.Bourguet** · 06/11/2008, 18h03

Envoyé par Zavonen

Et oui, c'est quoi le but final???
On est parti sur des modulos, nous voilà sur des puissances.
Comme le dit Pseudocode tous les langages proposent des calculs en précision illimités 'built-in'.

Ah? (Je n'oserait jamais faire d'affirmation aussi generique mais je ne dois pas chercher bien loin pour trouver des langages sans precision illimitees built-in, C est un cas).

A priori pour élever 3 à la puissance 40. Il faut faire 39 multiplications.
Mais on peut le faire avec seulement 8 multiplications. Le petit programme qui suit montre comment, il est basé sur une décomposition binaire de l'exposant.

Code python :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
#transforme n en base 2
def base2(n):
    if n<2:
        return [n]
    L=base2(n/2)
    L.insert(0,n%2)
    return L
 
# élévation de m à la puissance n
def power(m,n):
    c=0 # compteur de multiplications
    p2=m #variable de boucle contiendra les puissances binaires de m
    e=base2(n) # exposant en base 2
    R=1 # contiendra le résultat final
    for i in range(0,len(e)):
        if e[i]:# si le chiffre binaire de l'exposant est 1
            R*=p2
            c+=1  #et une de plus
        p2*=p2
        c+=1 # et une de plus
    return R,c
 
def main():
    print power(3,40)
    print pow(3,40)

Ce n'est pas toujours l'optimal, voir le bouquin de Knuth.

**Zavonen** · 06/11/2008, 18h17

Ce n'est pas toujours l'optimal, voir le bouquin de Knuth.

Qui a dit que ça l'était ?

Je n'oserait jamais faire

Moi, je n'oserais jamais conjuguer un verbe comme cela.
Chacun son truc...

**Twin111** · 10/11/2008, 01h18

Le but final, c'est tout simplement que je suis en ecole d'info, ou il faut pour ainsi dire, réinventer la roue

Donc le projet de la semaine derniere était un projet de bistromatique. Et maintenant je dois recoder la fonction "printf" en C. Mais j'aime beaucoup tout ce qui touche aux algos, donc je posais la question.

D'ailleurs; connaissez vous des sites qui parlerais d'algo appliqués à l'informatique ? Une sorte de bible des algos ^^ ?

**Jean-Marc.Bourguet** · 10/11/2008, 08h41

http://www.cs.sunysb.edu/~algorith/

**Alp** · 10/11/2008, 08h44

Envoyé par Twin111

D'ailleurs; connaissez vous des sites qui parlerais d'algo appliqués à l'informatique ? Une sorte de bible des algos ^^ ?

Il y a surtout LE livre sur le sujet : http://algo.developpez.com/livres/#L2100039229

**Twin111** · 10/11/2008, 23h08

Merci les gars, je sens que je vais courrir acheter certains de ses livres !

**Gorzyne** · 28/05/2019, 16h22

Bonjour à tous,

après deux jours de recherche j'ai enfin trouvé l'erreur dans l'algorithme de division de Knuth présenté dans https://www.developpez.net/forums/d8...rands-nombres/

donc pour ceux qui un jour pourraient être interessés par mettre en oeuvre cet algorithme, qui rappelons le traite de la division de très grands nombres, et donc trouve une application incontournable en cryptographie, il faut donc corriger la fin de l'algorithme la flemme de tout recopier

quand on entre dans la condition u<0 il faut corriger non pas de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

u=u+v

mais de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

u=u+v.B^j

ce qui est logique une fois qu'on a compris ce que fait l'algorithme

comme commentaire, cette coquille était assez dangereuse car les cas de figures où elle entre en oeuvre étaient assez rares, on pourrait donc avoir l'impression que l'algorithme renvoie le résultat correct, notamment en procédant une verification sur quelques échantillons ("j'ai essayé ma division sur 10 cas, ça fonctionne bien, donc l'algo est correct) ce qui est en général le cas, mais en fait dans certains cas le résultat est faux par exemple si je fais 304768 / 127 ça donne 2300 au lieu de 2399. Avec ma correction c'est bon.

je pense que ça serait bien de pouvoir poster la correction dans le topic initial.

**laurent_ott** · 07/06/2019, 19h10

Envoyé par Gorzyne

je pense que ça serait bien de pouvoir poster la correction dans le topic initial.

Bonjour et bravo pour ce travail.
Je pense que l'idéal serait que tu donnes le code complet puisque tu l'as sous la main, ça éviterait à ceux qui sont intéressés de se replonger dans les différentes discussions.
Et si possible, un pseudo code (compatible avec tous les langages de programmation) serait la cerise sur le gâteau.

Pour information, j'ai été confronté à ce problème et Unparia à donné un code très efficace pour le calcul du modulo lorsque le diviseur est petit (moins du 7 chiffres, c'est pratique par exemple pour les factorisations avec les premiers nombres premiers) en VBA :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
'-------------------------------------------------------------------------------
Public Function ModGNPD(ByVal vcChiffre As String, ByVal Diviseur As Long) As Variant
'-------------------------------------------------------------------------------
' Algorithme proposé par Unparia pour le calcul du modulo avec un très petit diviseur.
'-------------------------------------------------------------------------------
While Len(vcChiffre) > 9
    vcChiffre = CStr(Val(Left(vcChiffre, 9) Mod Diviseur)) & Mid(vcChiffre, 10)
Wend
ModGNPD = vcChiffre Mod Diviseur
End Function

**Gorzyne** · 12/06/2019, 09h00

Salut Laurent, en fait je pense que cet algorithme n'a aucun intérêt si on ne le couple pas intégralement avec les opérations arithmétiques en string: addition/soustraction/puissance/modulo... Avec changements de base (l'exponentiation modulaire se fait en base 2 p.e.) Ça fait beaucoup de code (offusqué) ... Et je n'ai pas encore fini mes travaux (génération de grands nombres premiers... ) ça demandera un peu de toilettage avant d'être diffusé

**Gorzyne** · 13/06/2019, 09h30

Bon je me lance

Voici l'algorithme de Knuth en VBA

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function diviser(u0 As String, v0 As String, b As Integer)
    n = Len(v0)
    m = Len(u0) - n
    Q = ""
    d = Int(b / (Mid(v0, 1, 1) + 1))
    u = multiplication(u0 & "", d & "")
    v = multiplication(v0 & "", d & "")
    For j = m To 0 Step -1
        qh = Int((indice(u, j + n) * b + indice(u, j + n - 1)) / Mid(v, 1, 1))
        rh = (indice(u, j + n) * b + indice(u, j + n - 1)) Mod Mid(v, 1, 1)
        If qh = b Or (qh * Mid(v, 2, 1) > rh * b + indice(u, j + n - 2)) Then
            qh = qh - 1
            rh = rh + Mid(v, 1, 1)
            If rh < b And (qh * Mid(v, 2, 1) > rh * b + indice(u, j + n - 2)) Then
                qh = qh - 1
                rh = rh + Mid(v, 1, 1)
            End If
        End If
        If Left(u, 1) = "-" Then Stop
 
        u = soustraire(u & "", multiplication(qh & "", multiplication(v & "", puissance(b & "", j & ""))))
 
        If Left(u, 1) = "-" Then
            u = soustraire(multiplication(v & "", puissance(b & "", j & "")), Right(u, Len(u) - 1))
            qh = qh - 1
        End If
 
        If Left(u, 1) = "-" Then Stop
        Q = Q & qh
    Next j
    'on enlève les zéros du début
    While Left(Q, 1) = 0
        Q = Right(Q, Len(Q) - 1)
    Wend
    diviser = Q
End Function

comme vous pouvez le voir il fait appel à des fonctions maisons pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
multiplication
soustraire
puissance

pour les fonctions multiplications et puissances , j'ai posté le code source dans un autre topic , là aussi en VBA, inspiré d'un code en Pascal, pour le petit nom c'est l'algorithme dit de Trachtenberg, diablement efficace.

https://www.developpez.net/forums/d1...ssance-string/

pour la soustraction, la version de Trachtenberg n'intègre pas les nombres négatifs, j'ai donc adapté un peu un petit code maison

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Function soustraire(S1 As String, S2 As String)
    L1 = Len(S1)
    L2 = Len(S2)
 
    If L1 > L2 Then 'S1 le plus petit
        For i = L2 To L1 - 1
            S2 = "0" & S2
        Next i
    ElseIf L2 > L1 Then '
        For i = L1 To L2 - 1
            S1 = "0" & S1
        Next i
    End If
    L1 = Len(S1)
    report = 0
    S = ""
    inter = ""
 
    'complément à 9 du soustracteur
    For i = L1 To 1 Step -1
        k = Right(9 - Mid(S2, i, 1), 1)
        inter = k & inter
    Next i
    'addition avec le premier membre
    inter2 = add_string(S1 & "", inter & "")
 
    If Len(inter2) > Len(S1) Then 'le résultat est positif
        inter3 = add_string(Left(inter2, 1) - 1 & Mid(inter2, 2, Len(inter2) - 1), "1")
        While Left(inter3, 1) = "0" And Len(inter3) > 1
            inter3 = Right(inter3, Len(inter3) - 1)
        Wend
    Else 'le résultat est négatif
        For i = Len(inter2) To 1 Step -1
            k = Right(9 - Mid(inter2, i, 1), 1)
            inter3 = k & inter3
        Next i
        While Left(inter3, 1) = "0" And Len(inter3) > 1
            inter3 = Right(inter3, Len(inter3) - 1)
        Wend
        inter3 = "-" & inter3
    End If
 
    soustraire= inter3
 
End Function

Ah oui j'appelle également une fonction indice dans la division, j'aurai pu me débrouiller qu'avec Mid() mais en fait l'algorithme initial ne précise pas qu'on a des cas "hors indice" auquel cas il faut renvoyer 0... par exemple si je demande le 6ème indice d'une chaîne qui ne fait que 5 caractères il faut renvoyer 0 ... ça m'a pris un peu de temps pour comprendre ça également

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function indice(u, i)
On Error GoTo finfonction
    indice = Mid(u, Len(u) - i, 1)
 
    Exit Function
finfonction:
indice = 0
End Function

ensuite avec cette division de Knuth c'est évidement pratique pour calculer des gros modulos, et vu qu'il s'agit d'une division entière ça tombe bien
la fonction s'appelle mod3

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function mod3(S As String, div As String)
    res = 0
    For i = 1 To Len(S)
        res = Modulo((add_string(multiplication(res & "", "10"), Mid(S, i, 1))), div & "")
    Next i
    mod3 = res
End Function

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Function Modulo(S1 As String, S2 As String)
    Modulo = soustraire(S1 & "", multiplication(S2 & "", diviser(S1 & "", S2, 10)))
End Function

Après pour ceux qui veulent aller plus loin et faire de la puissance modulaire, il faut passer en base 2 donc vous avez besoin de conversion décimal binaire et réciproquement en string dont voici le code

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Function convert_bin(myvar As String)
    Dim NBN As String
    Dim big0 As String
    Dim big As String
    Dim Bin As String
big0 = myvar & ""
5     big = big0 & ""
    AA = Len(big)
    For XX = 1 To AA
        L1 = Mid(big, XX, 1) + CRY
        CRY = 0
        If L1 = 0 Then
            FN = "0"
            GoTo 10
        End If
        If L1 \ 2 = L1 / 2 Then
            FN = L1 / 2
            GoTo 10
        End If
        If Int(L1 / 2) <> L1 / 2 Then
            FN = Int(L1 / 2)
            CRY = 10
            GoTo 10
        End If
10         NBN = NBN & FN
    Next XX
    If Left(NBN, 1) = "0" Then
        NBN = Right(NBN, (Len(NBN) - 1))
    End If
    If CRY = 10 Then Bin = "1" & Bin Else Bin = "0" & Bin
    big0 = NBN & ""
    If Len(NBN) > 0 Then
        NBN = ""
        CRY = 0
        GoTo 5
    End If
    convert_bin = Bin
End Function

puissance modulaire binaire

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function puissance_modulaire_binaire(g As String, exp As String, m As String)
    exp0 = exp
    base = g
    result = "1"
    While exp0 > 0
        If Right(exp0, 1) = 1 Then result = mod3(multiplication(result & "", base & ""), m & "")
        exp0 = "0" & Left(exp0, Len(exp0) - 1)
        base = mod3(multiplication(base & "", base & ""), m & "")
    Wend
    puissance_modulaire_binaire = result
End Function

opération inverse conversion binaire en décimal (ça peut servir)

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Function bin2dec(mybin As String)
    bin2dec = "0"
    mylen = Len(mybin)
    For i = 1 To mylen
        If Mid(mybin, i, 1) = "1" Then
            bin2dec = add_string(bin2dec & "", broutlami("2", (mylen - i) & ""))
        End If
    Next i
End Function

c'est trivial mais je le met quand même, le xor en string

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function chiffre_xor(text1 As String, cle2 As String)
    chiffre_xor = ""
    len_cle = Len(cle2)
    For i = 1 To Len(text1)
        chiffre_xor = chiffre_xor & (Mid(text1, i, 1) Xor Mid(cle2, 1 + ((i - 1) Mod len_cle), 1))
    Next i
End Function

en solde je vous gratifie d'une petite fonction de génération de nombre aléatoire en fonction des mouvements souris (nécessite de définir le POINTAPI, largement sourcé je détaille pas)

au niveau de la clé on met un peu ce qu'on veut en formule, ici j'ai mélangé du Rnd() avec du .X et .Y souris dans cette version

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function nb_alea_2(longueur As Integer)
    Dim position As POINTAPI
    Dim position_prev As POINTAPI
    cle = ""
    maint = Timer
    MsgBox "Veuillez appuyer sur OK et déplacer votre souris aléatoirement jusqu'à ce que la clé soit générée"
    'Range("état") = "Génération en cours: continuez de bouger la souris"
    While Timer < maint + 2
        DoEvents
    Wend
    While Len(cle) < longueur
        position_prev = position
        GetCursorPos position
        If position.x <> position_prev.x And position.y <> position_prev.y Then
            maint = Timer
            While Timer < maint + 0.1
                DoEvents
            Wend
            cle = cle & Right(Right(Int(Rnd() * 10), 1) + Right(position.x, 1) + Right(position.y, 1), 1)
        End If
    Wend
    nb_alea_2 = cle
    'Range("état") = "La clef est générée: vous pouvez arrêter de bouger la souris"
    'MsgBox "La clef est générée: vous pouvez arrêter de bouger la souris"
End Function

**laurent_ott** · 13/06/2019, 11h44

Bonjour Gorzyne.
J'ai récupéré l'ensemble de tes codes VBA pour les tester, histoire de voir s'ils sont plus rapides que ceux que j'avais, par exemple pour faire une division sur un grand nombre. Et malheureusement non, tes fonctions sont plus lentes.

Par exemple pour diviser
"2123487914341640748721363763898849434212102775632653001833314535451684428025884160564630174412406003395971580607230447530234280769413999637353375912165376"
par "187187187187187187187187187187187187187187187187"
Avec mes codes, c'est instantané, avec les tiens ça prend une seconde.

Pire, j'ai cru avoir planté mon PC avec ta fonction puissance("299",2991), alors qu'avec PuissanceGN("299",2991) le résultat est instantané.

Voici les codes que j'ai regroupé en 3 parties. Les deux premières parties sont issues de http://fordom.free.fr, la dernière partie regroupe des fonctions personnelles pour les divisions et les modulos car rien n'existait dans fordom.

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
'---------------------------------------------------------------------------------------
' http://fordom.free.fr/
'---------------------------------------------------------------------------------------
 
Option Explicit
 
'---------------------------------------------------------------------------------------
Public Function Pgcd2(ByVal a As Variant, ByVal b As Variant) As Variant
'---------------------------------------------------------------------------------------
' Calcul le PGCD de deux nombres
' Variante optimisant l'Algo d'Euclide
'---------------------------------------------------------------------------------------
 
' Déclarations:
Dim R As Variant
 
' Validité paramètre:
a = CDec(Abs(a))
b = CDec(Abs(b))
If a = 0 And b = 0 Then Pgcd2 = "#NOMBRE!": Exit Function 'Pas de solution
If a < b Then R = CDec(b): b = a: a = R 'inverse les valeurs
 
' Calcul:
Do While Abs(b) >= 1
    R = a - Int(a / b + 0.5) * b 'permet le calcul modulo en mode decimal (28 chiffres) contrairement à r = a Mod b
    a = b
    b = R
Loop
Pgcd2 = Abs(a)
End Function
 
'---------------------------------------------------------------------------------------
Public Function ExpoMod(ByVal nb As Variant, ByVal Expo As Variant, _
                         ByVal Modulo As Variant) As Variant
'---------------------------------------------------------------------------------------
' EXPONENTIATION MODULAIRE RAPIDE : Nb^Expo MOD Modulo.
'---------------------------------------------------------------------------------------
' Convertit les variants en Decimal:
nb = CDec(nb): Expo = CDec(Expo): Modulo = CDec(Modulo)
 
' Traitement:
ExpoMod = 1
Do
    If MOD2(Expo, 2) = 1 Then
        ExpoMod = MODProd(nb, ExpoMod, Modulo)
        Expo = (Expo - 1) / 2
        nb = MODProd(nb, nb, Modulo)
    End If
 
If MOD2(Expo, 2) = 0 Then
        ExpoMod = MODProd(ExpoMod, 1, Modulo)
        Expo = Expo / 2
        nb = MODProd(nb, nb, Modulo)
    End If
 
Loop Until Expo = 0
End Function
 
'---------------------------------------------------------------------------------------
Public Function MOD2(ByVal d As Variant, ByVal N As Variant) As Variant
'---------------------------------------------------------------------------------------
' Renvoie le modulo de d et n:
'---------------------------------------------------------------------------------------
d = CDec(d): N = CDec(N)
MOD2 = CDec(d - N * Int(d / N))
End Function
 
'---------------------------------------------------------------------------------------
Public Function IsMultiple(ByVal Nb1 As Variant, ByVal Nb2 As Variant) As Boolean
'---------------------------------------------------------------------------------------
' Teste si Nb1 est multiple de Nb2.
'---------------------------------------------------------------------------------------
Nb1 = CDec(Nb1): Nb2 = CDec(Nb2)
If Nb2 = 0 Then IsMultiple = True: Exit Function
IsMultiple = ((Int(Nb1 / Nb2) = Nb1 / Nb2) And Nb1 <> 0)
End Function
 
'---------------------------------------------------------------------------------------
Public Function MODProd(ByVal Nb1 As Variant, ByVal Nb2 As Variant, _
                         ByVal Modulo As Variant) As Variant
'---------------------------------------------------------------------------------------
' Renvoie le modulo du produit "nb1*nb2 MOD Modulo" sans la limite Double.
'---------------------------------------------------------------------------------------
' Paramètre les variables en Decimal:
Nb1 = CDec(Nb1): Nb2 = CDec(Nb2): Modulo = CDec(Modulo)
 
' Convertit les variants en Decimal:
Dim R As Variant, C As Variant, Facteur As Variant, d As Variant
R = CDec(R): C = CDec(C): Facteur = CDec(Facteur): d = CDec(d)
 
' Teste la grandeur du produit:
'If Len(Nb1) + Len(Nb2) < 16 Then MODProd = MOD2(Nb1 * Nb2, Modulo): Exit Function
 
' Prend le mini => plus rapide:
If Nb1 < Nb2 Then R = Nb2: Nb2 = Nb1: Nb1 = R
 
' Optimisation facteur:
Facteur = 9
R = MOD2(Nb1, Modulo)
Do
    If IsMultiple(Nb2, Facteur) Then
        R = MOD2(Facteur * R, Modulo)
        Nb2 = Nb2 / Facteur
    Else
        d = MOD2(Nb2, Facteur)
        C = MOD2(C + R * d, Modulo)
        Nb2 = Nb2 - d
    End If
Loop Until Nb2 = 0
MODProd = MOD2(C, Modulo)
End Function
'---------------------------------------------------------------------------------------

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
 
'---------------------------------------------------------------------------------------
' http://fordom.free.fr/
'---------------------------------------------------------------------------------------
 
Option Explicit
 
Function AGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'ADDITION SIGNEE DE 2 GRANDS NOMBRES
 
'Info sur les longueurs des termes
Dim L1 As Long, L2 As Long
L1 = Len(Nb1): L2 = Len(Nb2)
 
'Recherche des signes et conversion en nombre positif
Dim S1 As Long, S2 As Long
S1 = 1: S2 = 1
If Left$(Nb1, 1) = "-" Then S1 = -1: Nb1 = Right$(Nb1, L1 - 1): L1 = L1 - 1
If Left$(Nb2, 1) = "-" Then S2 = -1: Nb2 = Right$(Nb2, L2 - 1): L2 = L2 - 1
 
'Recherche de la décimale et conversion en entier
Dim P1 As Long, P2 As Long, virgule As Long, PS1 As Long, PS2 As Long
Dim Z As String 'optimisation pour les string$ qui suivent
Z = "0"
 
    'Recherche emplacement de la virgule
    P1 = InStr(1, Nb1, ",") + InStr(1, Nb1, ".")
    P2 = InStr(1, Nb2, ",") + InStr(1, Nb2, ".")
    'Recompose en entier
    Dim Nb1Prov As String, Nb2Prov As String
    PS1 = 0: PS2 = 0
    If P1 > 0 Then
        PS1 = L1 - P1
        Nb1Prov = Left$(Nb1, P1 - 1)
    End If
    If P2 > 0 Then
        PS2 = L2 - P2
        Nb2Prov = Left$(Nb2, P2 - 1)
    End If
    If PS1 > PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
      ElseIf PS1 < PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2)
      Else
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
    End If
    'Retrouve les bonnes longueurs
    L1 = Len(Nb1): L2 = Len(Nb2)
    'Trouve la bonne position de la décimale du résultat
    virgule = IIf(PS2 > PS1, PS2, PS1)
 
'Comparaison des termes si soustraction
If S1 <> S2 Then
Dim Pgdd As Long, Lmax As Long
'Renvoi 1 si Nb1>Nb2, sinon -1 ou Revoi 0 si égalité avec Nb1 et Nb2 >=0
Lmax = L1
If L1 < L2 Then Lmax = L2
Pgdd = StrComp(String$(Lmax - L1, Z) & Nb1, String$(Lmax - L2, Z) & Nb2)
If Pgdd = 0 Then AGN = "0": Exit Function 'égalité
End If
 
'Transformation en longueur multiple de Multiple
Dim Multiple As Long
Multiple = 14
 
Dim lgmul As Long
lgmul = (IIf(L1 < L2, L2, L1) \ Multiple + 1) * Multiple
Nb1 = String$(lgmul - L1, Z) & Nb1
Nb2 = String$(lgmul - L2, Z) & Nb2
 
'Variables
Dim Total As String
Dim T As Long
Dim v1 As Double, v2 As Double, R As Double, Ret As Long
Dim lr As Long
Dim ln10 As Double
ln10 = Log(10)
 
'Déclare le résultat à la longueur maxi
Total = String$(lgmul, Z)
 
'Fait l'opération puis met en forme
If S1 = S2 Then
    'Addition
    For T = lgmul - Multiple + 1 To 1 Step -Multiple
        v1 = Mid$(Nb1, T, Multiple)
        v2 = Mid$(Nb2, T, Multiple)
        R = v1 + v2 + Ret
        lr = Fix(Log(R + 0.11) / ln10) + 1
        If lr = Multiple + 1 Then Ret = 1 Else Ret = 0
        Mid$(Total, T - lr + Multiple, lr) = CStr(R)
    Next T
    'Replacement de la virgule
    If virgule <> 0 Then Total = Left$(Total, Len(Total) - virgule) & "," & Right$(Total, virgule)
    'Mise en forme
    AGN = ZeroGN(Total)
    'Règle des signes
    If S1 = -1 And AGN <> "0" Then AGN = "-" & AGN
Else
    'Soustraction
    Dim base As Double
    base = 10 ^ (Multiple + 1)
    For T = lgmul - Multiple + 1 To 1 Step -Multiple
        v1 = Mid$(Nb1, T, Multiple)
        v2 = Mid$(Nb2, T, Multiple)
        R = v1 - v2 + Ret
        Ret = 0
        If Sgn(R) <> Pgdd And R <> 0 Then
            R = Pgdd * base + R
            Ret = -Pgdd
        End If
        lr = Fix(Log(Abs(R) + 0.11) / ln10) + 1
        Mid$(Total, T - lr + Multiple, lr) = CStr(Abs(R))
    Next T
    'Replacement de la virgule
    If virgule <> 0 Then Total = Left$(Total, Len(Total) - virgule) & "," & Right$(Total, virgule)
    'Mise en forme
    AGN = ZeroGN(Total)
    'Règle des signes
    If Pgdd * S1 = -1 Then AGN = "-" & AGN
End If
 
End Function
 
'=========================
 
 Function ZeroGN(ByVal Term1 As String) As String
'RETIRE LES ZEROS INUTILES
 
'Boucle de recherche des zéros inutiles dans la partie entière
Dim i As Long
For i = 1 To Len(Term1)
    If Mid$(Term1, i, 1) <> "0" Then Exit For
Next i
Term1 = Mid$(Term1, i)
If Term1 = vbNullString Then Term1 = "0" 'traite le cas d'un nombre nul
 
'Recherche si virgule
Dim v As Long
v = InStr(1, Term1, ",") + InStr(1, Term1, ".")
 
'Recherche si Term1<1, si oui remet un zéro devant la virgule
If v = 1 Then Term1 = "0" & Term1: v = 2
 
'Boucle de recherche des zéros inutiles dans partie décimale
If v > 0 Then
For i = Len(Term1) To v - 1 Step -1
    If Mid$(Term1, i, 1) <> "0" Then Exit For
Next i
Term1 = Left$(Term1, i)
End If
 
'Recherche si dernier=virgule, si oui=supprime
If v = Len(Term1) Then Term1 = Left$(Term1, v - 1)
 
'Renvoi
ZeroGN = Term1
 
End Function
 
'=========================
 
Function FactGN(ByVal a As Long, Optional b As Variant = 2) As String
'CALCUL FACTORIELLE
 
'Traitement option : B=1er nb de départ
b = CLng(b)
 
'Traitement des cas triviaux
If a < 0 Then FactGN = "#VALEUR!": Exit Function
If a = 0 Then FactGN = 1: Exit Function
 
'Variables
Dim base As Double, P As Double, Q As Double
Dim N As Long, j As Long, i As Long
Dim Expo As Long
 
'Base dynamique optimisée
Expo = 15 - Len(Trim(Str$(a))) 'évite P>10^15 et donc le formattage exponentiel (1E15) !!
 
'Base de calcul
base = 10 ^ Expo
 
'Nombre d'indice dans la base
N = Int((0.92 + (a + 0.5) * Log(a) - a) / Log(10)) + 1 'nb chiffre de A!
N = Int(N / Expo) + 1
 
'Déclaration des indices
ReDim T(N) As Double
T(0) = 1
 
'Algorithme factorielle
For j = b To a
    For i = 0 To N
        P = T(i) * j + Q
        Q = Int(P / base)
        T(i) = P - Q * base
    Next i
Next j
 
'Rajoute les zeros devant les indices moins long que expo
Dim Z As String 'optimisation string$
Z = "0"
Dim ln10 As Double
ln10 = Log(10)
For i = N To 0 Step -1
    FactGN = FactGN & String$(Expo - 1 - Fix(Log(T(i) + 0.11) / ln10), Z) & T(i)
Next i
 
'Supprime les zeros inutiles du début
FactGN = ZeroGN(FactGN)
 
End Function
 
'========================
 
Function ArrangGN(ByVal N As Long, ByVal P As Long) As String
'ARRANGEMENT de P objets avec N objets au total
 
If P > N Then ArrangGN = "#NOMBRE!": Exit Function
P = N - P + 1 'dernier indice dans l'algo factorielle
If P < 0 Then ArrangGN = "#VALEUR!": Exit Function
ArrangGN = FactGN(N, P)
 
End Function
 
'=========================
 
Function PGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'PRODUIT GRANDS NOMBRES
 
'Info sur les longueurs des termes
Dim L1 As Long, L2 As Long
L1 = Len(Nb1): L2 = Len(Nb2)
 
'Recherche des signes et conversion en nombre positif
Dim S1 As Long, S2 As Long
S1 = 1: S2 = 1
If Left$(Nb1, 1) = "-" Then S1 = -1: Nb1 = Right$(Nb1, L1 - 1): L1 = L1 - 1
If Left$(Nb2, 1) = "-" Then S2 = -1: Nb2 = Right$(Nb2, L2 - 1): L2 = L2 - 1
 
'Recherche de la décimale et conversion en entier
Dim P1 As Long, P2 As Long, virgule As Long
 
    'Recherche emplacement de la virgule
    P1 = InStr(1, Nb1, ",") + InStr(1, Nb1, ".")
    P2 = InStr(1, Nb2, ",") + InStr(1, Nb2, ".")
    'Recompose en entier
    If P1 > 0 Then
        Nb1 = Left$(Nb1, P1 - 1) & Right$(Nb1, L1 - P1)
        virgule = L1 - P1
        L1 = L1 - 1
    End If
    If P2 > 0 Then
        Nb2 = Left$(Nb2, P2 - 1) & Right$(Nb2, L2 - P2)
        virgule = virgule + L2 - P2
        L2 = L2 - 1
    End If
 
'Découpage en tranche
Dim K1 As Long, K2 As Long, Kt As Long
K1 = L1 \ 7 + 1: K2 = L2 \ 7 + 1: Kt = K1 + K2
 
'Tableaux de stockage des tranches
ReDim a(K1) As Double, b(K2) As Double
 
'Remplissage tableau
Dim i As Long, j As Long
 
For i = 0 To K1 - 2
a(i) = Mid$(Nb1, L1 - 6 - i * 7, 7)
Next i
a(K1 - 1) = 0
If L1 Mod 7 <> 0 Then a(K1 - 1) = Left$(Nb1, L1 Mod 7)
 
For i = 0 To K2 - 2
b(i) = Mid$(Nb2, L2 - 6 - i * 7, 7)
Next i
b(K2 - 1) = 0
If L2 Mod 7 <> 0 Then b(K2 - 1) = Left$(Nb2, L2 Mod 7)
 
'Base de calcul
Dim base As Long
base = 10 ^ 7
 
'Déclaration des indices
ReDim T(Kt + 1) As Double
 
'Algo multiplication
Dim P As Double, Q As Double, k As Long, Saut As Long, l As Double
Saut = 90
For j = 0 To K1
    l = a(j)
    If j = Saut Then Saut = Saut + 90: GoSub Recalcul
    For i = 0 To K2
        T(i + j) = l * b(i) + T(i + j)
    Next i
Next j
GoSub Recalcul
GoTo Suite:
 
Recalcul: 'recalculs des indices t() dans la Base avant dépassement de capacité
P = 0
For k = 0 To K2 + j
    Q = Int((T(k) + P) / base)
    T(k) = T(k) + P - Q * base
    P = Q
Next k
Return
Suite:
 
'Rajoute les zeros dans les indices moins long que 7 chiffres
Dim Z As String 'optimisation string$
Z = "0"
Dim ln10 As Double
ln10 = Log(10)
For i = Kt To 0 Step -1
    PGN = PGN & String$(6 - Fix(Log(T(i) + 0.11) / ln10), Z) & T(i)
Next i
 
'Supprime les zeros inutiles
PGN = ZeroGN(PGN)
 
'Replacement de la virgule
Dim PS As Long
If virgule <> 0 Then
    PS = Len(PGN) - virgule
    If PS < 0 Then PGN = String$(-PS, Z) & PGN
    PGN = Left$(PGN, Len(PGN) - virgule) & "," & Right$(PGN, virgule)
End If
 
'Mise en forme
PGN = ZeroGN(PGN)
 
'Règle des signes
If S1 * S2 = -1 And PGN <> "0" Then PGN = "-" & PGN
 
End Function
 
'===============================
Function PuissanceGN(ByVal Nb1 As String, ByVal Expo As Long) As String
'PUISSANCE ENTIERE D'UN GRAND NOMBRE (décimal ou entier)
If Expo = 0 Then PuissanceGN = 1: Exit Function
If Expo = 1 Then PuissanceGN = Nb1: Exit Function
PuissanceGN = "1"
Do
    If Expo And 1 Then PuissanceGN = PGN(PuissanceGN, Nb1)
    Expo = Expo \ 2
    Nb1 = PGN(Nb1, Nb1)
Loop While Expo > 1
    PuissanceGN = PGN(PuissanceGN, Nb1)
 
End Function
 
'===============================
 
Function AbsGN(ByVal nb As String) As String
'Equivalent à ABS()
If Left$(nb, 1) = "-" Then AbsGN = Mid$(nb, 2) Else AbsGN = nb
End Function
 
'===============================
 
Function SgnGN(ByVal nb As String) As Long
'Equivalent à SGN()
 
nb = ZeroGN(nb)
If nb = "0" Then SgnGN = 0: Exit Function
Dim premier As String * 1
premier = Left$(nb, 1)
Select Case premier
    Case "-"
        SgnGN = -1
    Case Else
        SgnGN = 1
End Select
End Function
 
'===============================
 
Function IntGN(ByVal nb As String) As String
'Equivalent à INT()
 
nb = ZeroGN(nb)
Dim P As Long, Signe As Long
P = InStr(nb, ",") + InStr(nb, ".")
If P = 0 Then IntGN = nb: Exit Function
Signe = SgnGN(nb)
Select Case Signe
    Case -1
        IntGN = AGN(Left$(nb, P - 1), "-1")
    Case Else
        IntGN = Left$(nb, P - 1)
End Select
End Function
 
'===============================
 
Function FixGN(ByVal nb As String) As String
'Equivalent à FIX()
 
nb = ZeroGN(nb)
Dim P As Long
P = InStr(nb, ",") + InStr(nb, ".")
If P = 0 Then FixGN = nb: Exit Function
FixGN = Left$(nb, P - 1)
 
End Function
 
'=========================
 
Function CompGN(ByVal Nb1 As String, ByVal Nb2 As String) As Long
'Renvoie 1 si Nb1>Nb2,
'Renvoie -1 si Nb1<Nb2
'Renvoi 0 si égalité
 
'format sans zero inutile
Nb1 = ZeroGN(Nb1): Nb2 = ZeroGN(Nb2)
 
'Regarde le signe
Dim Signe1 As String * 1, Signe2 As String * 1, Inverse As Long
Signe1 = Left$(Nb1, 1): Signe2 = Left$(Nb2, 1): Inverse = 1
If Signe1 = "-" And Signe2 <> "-" Then CompGN = "-1": Exit Function
If Signe1 <> "-" And Signe2 = "-" Then CompGN = "1": Exit Function
If Signe1 = "-" And Signe2 = "-" Then Nb1 = AbsGN(Nb1): Nb2 = AbsGN(Nb2): Inverse = -1
 
'Définitions
Dim P1 As Long, P2 As Long, PS1 As Long, PS2 As Long
Dim Z As String 'optimisation pour les string$ qui suivent
Z = "0"
 
'Info sur les longueurs des termes
Dim L1 As Long, L2 As Long
L1 = Len(Nb1): L2 = Len(Nb2)
 
'Recherche emplacement de la virgule
    P1 = InStr(1, Nb1, ",") + InStr(1, Nb1, ".")
    P2 = InStr(1, Nb2, ",") + InStr(1, Nb2, ".")
    'Recompose en entier
    Dim Nb1Prov As String, Nb2Prov As String
    PS1 = 0: PS2 = 0
    If P1 > 0 Then
        PS1 = L1 - P1
        Nb1Prov = Left$(Nb1, P1 - 1)
    End If
    If P2 > 0 Then
        PS2 = L2 - P2
        Nb2Prov = Left$(Nb2, P2 - 1)
    End If
    If PS1 > PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
      ElseIf PS1 < PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2)
      Else
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
    End If
 
    'Retrouve les bonnes longueurs
    L1 = Len(Nb1): L2 = Len(Nb2)
 
    'Le maxi
    Dim Lmax As Long
    Lmax = L1
    If L1 < L2 Then Lmax = L2
 
'Comparaison
CompGN = Inverse * StrComp(String$(Lmax - L1, Z) & Nb1, String$(Lmax - L2, Z) & Nb2)
End Function
 
'=========================
 
Function MinGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'Renvoi le nb mini
 
If CompGN(Nb1, Nb2) = -1 Then
    MinGN = Nb1
Else
    MinGN = Nb2
End If
 
End Function
 
'=========================
Function MaxGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'Renvoi le nb maxi
 
If CompGN(Nb1, Nb2) = 1 Then
    MaxGN = Nb1
Else
    MaxGN = Nb2
End If
 
End Function
 
 
'=========================
 
Function ArrondiGN(ByVal nb As String, Optional ByVal Pos As Variant = 16) As String
'ARRONDI(nombre;no_chiffres)
'Equivalent à ARRONDI d'Excel
 
'supprime les zeros inutiles
nb = ZeroGN(nb)
 
'Recherche emplacement de la virgule
Dim P As Long
P = InStr(1, nb, ",") + InStr(1, nb, ".")
 
'Si entier alors rajoute une virgule
If P = 0 Then P = Len(nb) + 1: nb = nb & ",0"
 
'vérifie que partie entière assez long
If -Pos >= P Then ArrondiGN = "0": Exit Function
 
'transforme en nb sans virgule
If P > 0 Then nb = Left$(nb, P - 1) & Right$(nb, Len(nb) - P)
 
'dernier chiffre à retenir pour arrondi
Dim C As Long, a As String
C = Val(Mid$(nb, P + Pos, 1))
a = Str$(SgnGN(nb))
 
'coupe nb
nb = Left$(nb, P + Pos - 1)
 
'arrondi
If C >= 5 Then
    Dim ZeroDeb As String 'traite le cas du zero devant qui sera supprimé par AGN
    ZeroDeb = Left$(nb, 1)
    nb = AGN(nb, a)
    If ZeroDeb = "0" Then nb = "0" & nb
End If
 
'reconstruit le nb
If Len(nb) >= P Then
    ArrondiGN = Left$(nb, P - 1) & "," & Right$(nb, Len(nb) - P + 1)
Else
    Dim enplus As Long
    enplus = 0
    If -Pos = P - 1 And SgnGN(nb) = 1 Then enplus = 1
    If -Pos = P - 2 And SgnGN(nb) = -1 Then enplus = 1
    ArrondiGN = nb & String$(P - Len(nb) - 1 + enplus, "0")
End If
 
'supprime les zeros inutiles
ArrondiGN = ZeroGN(ArrondiGN)
 
End Function
 
'=========================
 
Function RndGN(Optional ByVal Deci As Variant = 16) As String
'Equivalent à Rnd + Randomize : renvoi nb dans [0;1[
 
'Traitement option
Deci = CLng(Deci)
 
'Initialisation série
Randomize Timer
 
'Déclaration
Dim bfin As Long, T As Long, NbRnd As String, base As Double, nb As String
base = 10 ^ 15
 
'Complète par série de 15 chiffres entiers aléatoires
bfin = Deci \ 15
NbRnd = Space$((bfin + 1) * 15)
 
'Fabrique le nb
For T = 0 To bfin
    nb = Trim$(Str$(Int(Rnd * base)))
    Mid$(NbRnd, T * 15 + 1, 15) = String$(15 - Len(nb), "0") & nb
Next T
RndGN = "0," & NbRnd
 
'Arrondi à Deci et met en forme
RndGN = ZeroGN(ArrondiGN(RndGN, Deci))
 
End Function
 
'=========================
 
Function RndBorneGN(ByVal Borne1 As String, Borne2 As String, Optional ByVal Deci As Variant = 16) As String
'Renvoi un nb décimal entre deux bornes
 
'Traitement option
Deci = CLng(Deci)
 
'Fabrique un nb : RNDGN()*(b-a)+a
RndBorneGN = ArrondiGN(AGN(PGN(AGN(Borne2, InverseGN(Borne1)), RndGN(Deci + Len(Borne1) + Len(Borne2))), Borne1), Deci)
 
End Function
 
'=========================
 
Function InverseGN(ByVal nb As String) As String
'Inverse le signe d'un nb
 
If Left$(nb, 1) = "-" Then
    InverseGN = AbsGN(nb)
    Exit Function
Else
    InverseGN = "-" & nb
End If
 
End Function

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
 
Option Explicit
 
'---------------------------------------------------------------------------------------
Public Function DGN(ByVal vcChiffre As String, _
                    ByVal Diviseur As Variant, _
                    Optional ByRef Reste As Variant, _
                    Optional ByVal Précision As Integer = 0) As Variant
'---------------------------------------------------------------------------------------
' Division de vcChiffre (Entier Positif ou Négatif) par Diviseur (Entier Positif ou Négatif).
' Retourne : le Quotient d'un grand nombre si AvecVirgule=False,
'          : la division avec une précision jusqu'à de 28 chiffres si Précision>0.
' Renseigne : Reste = le reste sous la forme d'un entier grand nombre.
'---------------------------------------------------------------------------------------
Dim N As Long
Dim Quotient As Variant, Dividende As Variant
Dim Q As String
Dim Signe As String
 
If Left(vcChiffre, 1) = "-" And Left(Diviseur, 1) <> "-" Then Signe = "-"
If Left(vcChiffre, 1) <> "-" And Left(Diviseur, 1) = "-" Then Signe = "-"
 
vcChiffre = AbsGN(vcChiffre)
Diviseur = AbsGN(Diviseur)
 
Select Case Len(Diviseur)
 
    ' Si le diviseur est petit:
    Case Is <= 27
 
        ' Si le chiffre est lui aussi petit:
        If Len(vcChiffre) <= 27 Then
 
            DGN = CDec(Int(CDec(vcChiffre) / CDec(Diviseur)))
            Reste = MOD2(vcChiffre, Diviseur)
 
        ' Sinon le chiffre est grand (mais le diviseur est petit):
        Else
 
            N = 27
            Dividende = Mid(vcChiffre, 1, N)
            Quotient = Int(CDec(Dividende) / CDec(Diviseur))
            Reste = CDec(Dividende) - CDec(Quotient * Diviseur)
            Q = CStr(Quotient)
 
            While N < Len(vcChiffre)
                N = N + 1
                Dividende = CDec(Reste) & Mid(vcChiffre, N, 1)
                Quotient = Int(CDec(Dividende) / CDec(Diviseur))
                Q = Q & Quotient
                Reste = CDec(Dividende) - CDec(Quotient * Diviseur)
            Wend
 
            ' Boucle de recherche des zéros inutiles dans la partie entière
            For N = 1 To Len(Q)
                If Mid$(Q, N, 1) <> "0" Then Exit For
            Next N
            Q = Mid$(Q, N)
            If Q = vbNullString Then Q = "0" ' Cas d'un nombre nul
 
            DGN = Q
 
        End If
 
    ' Dans les autres cas le diviseur est grand (et le chiffre surement aussi):
    Case Else
 
        DGN = DivGN(vcChiffre, Diviseur, Reste)
 
End Select
 
' S'il faut retourner un nombre avec virgule et pas un entier:
If Précision > 0 Then
    Dim v As Variant, a As Variant, b As Variant, i As Integer
    a = CDec(Mid(Reste, 1, 27))
    b = CDec(Mid(Diviseur, 1, 27))
    If Len(Diviseur) > 27 Then i = Len(Diviseur) - 27
    If Len(Reste) > 27 Then i = i - (Len(Reste) - 27)
    If i > 0 And i <= 27 Then a = a / (10 ^ i)
    If i > 27 Then a = 0
    v = Round(a / b, Précision)
    DGN = AGN(DGN, v)
End If
 
' Gestion des signes négatifs:
DGN = Signe & DGN
 
End Function
 
'-------------------------------------------------------------------------------
Private Function DivGN(ByVal vcChiffre As String, ByVal Diviseur As String, _
                       Optional ByRef Reste As Variant) As Variant
'-------------------------------------------------------------------------------
' Division d'un grand nombre entier positif par un diviseur entier positif.
' Méthode inspirée de cette discussion:
' <a href="https://www.developpez.net/forums/d1019631/bases-donnees/ms-sql-server/developpement/probleme-utilisation-modulo/#post5686484" target="_blank">https://www.developpez.net/forums/d1...o/#post5686484</a>
' Retourne : le Quotient d'un grand nombre vcChiffre divisé par Diviseur.
' Renseigne : Reste = le reste sous la forme d'un entier grand nombre.
'-------------------------------------------------------------------------------
Dim iIndice As Long, iTemporaire As String
Dim div As String
Reste = ""
 
While Len(vcChiffre) > 0
    iIndice = Len(vcChiffre) Mod 10
    If iIndice = 0 Then iIndice = 10
    iTemporaire = AGN(Reste & "0000000000", Val(Mid(vcChiffre, 1, iIndice)))
    vcChiffre = Mid(vcChiffre, iIndice + 1, Len(vcChiffre) - iIndice)
    div = div & DivLog2GN(iTemporaire, Diviseur, Reste, "0000000000")
Wend
 
' Supprime les zéros inutiles au début du chiffre:
iIndice = 1
While Mid$(div, iIndice, 1) = "0"
    iIndice = iIndice + 1
Wend
 
' Retourne la division:
DivGN = Mid$(div, iIndice)
If DivGN = "" Then DivGN = "0" ' Cas d'un nombre nul
End Function
 
'-------------------------------------------------------------------------------
Private Function DivLog2GN(ByVal vcChiffre As String, ByVal Diviseur As String, _
                           Optional ByRef Reste As Variant, _
                           Optional ByRef FormatZéro As Variant = "") As Variant
'-------------------------------------------------------------------------------
' Utilise les logarithmes pour faire une division d'un grand nommbre.
' Retourne : le Quotient d'un grand nombre vcChiffre divisé par Diviseur.
' Renseigne : Reste = le reste sous la forme d'un entier grand nombre.
'-------------------------------------------------------------------------------
Dim Q As Variant, QQ As String
Dim Début As String, Fin As String, div As String
 
' Si le dividende est plus petit que le diviseur
' alors retourne 0 et le dividende est le reste:
If CompGNrapide(vcChiffre, Diviseur) < 0 Then
    DivLog2GN = 0
    Reste = vcChiffre
    Exit Function
End If
 
QQ = vcChiffre
div = "0"
 
' Une division est une soustraction de log(dividende) - log(diviseur):
' Ce qui donne un "minima" puisque le log n'est pas toujours assez précis.
' Ce minima + 1 donne le maxima et maxima fois diviseur doit être inférieur
' au dividende, dans ce cas la division est trouvée,
' sinon il faut reprendre avec la partie représentant l'écart entre le dividende
' et le minima fois le diviseur. Et ainsi de suite.
Do
 
    Q = LogGN(QQ) - LogGN(Diviseur)
    Q = CDec(Q)
    Début = PuissanceGN("2,718281828459", Int(Q))
    Début = PGN(Début, exp(Q - Int(Q)))
    Début = IntGN(Début)
 
    div = AGN(div, Début)
    QQ = AGN(vcChiffre, "-" & PGN(div, Diviseur))
 
    Fin = AGN(div, "1")
 
Loop While CompGNrapide(PGN(Fin, Diviseur), vcChiffre) < 1
 
Reste = QQ
 
' Si le reste est négatif c'est qu'il y a une erreur,
' le diviseur est trop grand et il faut le diminuer:
While Left(Reste, 1) = "-"
    div = AGN(div, "-1")
    Reste = AGN(vcChiffre, "-" & PGN(div, Diviseur))
Wend
 
DivLog2GN = Format(div, FormatZéro)
 
End Function
 
'-------------------------------------------------------------------------------
Public Function LogGN(ByVal vcChiffre As String) As Variant
'-------------------------------------------------------------------------------
' Retourne le Log2 d'un grand nombre Entier Positif.
' En VBA log() est limité à 10^308, donc au dela il faut calculer soit même le log.
'-------------------------------------------------------------------------------
Dim Chiffre As Variant
Chiffre = Left(vcChiffre, 1) & "." & Mid(vcChiffre, 2, 12)
Chiffre = Val(Chiffre)
If Len(vcChiffre) < 300 Then
    LogGN = Log(Chiffre) + Log(10 ^ (Len(vcChiffre) - 1))
Else
    LogGN = Log(Chiffre) + ((Len(vcChiffre) - 1) * 2.30258509299405)
End If
End Function
 
'-------------------------------------------------------------------------------
Public Function SqrGN(ByVal a As String, Optional ByVal Précision As Byte = 10) As String
'-------------------------------------------------------------------------------
' Retourne la racine carrée (approximative) d'un grand nombre Entier Positif.
' Inspiré de l'algorithme d'HÉRON.
'-------------------------------------------------------------------------------
' Limite de la précision à 10 décimale:
If Précision > 10 Then Précision = 10
 
' Si la racine peut être calculée alors la retourner:
If Len(a) <= 15 Then SqrGN = Round(Sqr(CDec(a)), Précision): Exit Function
 
' Sinon il faut la calculer:
Dim x1, x2, x0, i As Byte
x1 = a
 
For i = 1 To 250
    x2 = DGN(a, IntGN(AGN(x1, x1)), 0, 0)
    x1 = AGN(PGN(x1, "0.5"), x2)
    If x1 = x0 Then Exit For
    If x1 < 1 Then Exit For
    x0 = x1
Next i
 
' Arrondi à l'entier le plus proche:
x1 = ArrondiGN(x1, 0)
 
' Traitement pour rechercher les décimales:
If Précision > 0 Then
    x0 = AGN(a, "-" & PGN(x1, x1))  ' Calcule l'écart du carré par rapport au nombre.
    x2 = "0"
    While x0 <> x2
        x2 = x0
        x0 = DGN(x0, a, 0, 28)          ' En déduit le pourcentage.
        If x0 > 0 And x0 < 1 Then
            x0 = SqrPN(CDec(1) + CDec(x0))  ' Calcule la racine carrée précise sur un petit nombre.
            x1 = PGN(x1, x0)                ' Ajoute la racine carré du pourcentage calculé.
            x0 = AGN(a, "-" & PGN(x1, x1))  ' Calcule l'écart du carré par rapport au nombre.
        Else
            x2 = x0 ' Force la sortie de la boucle.
        End If
    Wend
End If
 
SqrGN = ArrondiGN(x1, Précision)
End Function
 
'-------------------------------------------------------------------------------
Private Function SqrPN(a As Variant) As Variant
'-------------------------------------------------------------------------------
' Calcule la racine carrée d'un petit nombre de façon plus précise que la formule VBA.
'-------------------------------------------------------------------------------
Dim i As Byte, x0, x1
x1 = a
For i = 1 To 250
    x1 = x1 * 0.5 + (CDec(a) / (CDec(2) * CDec(x1)))
    If x1 = x0 Then Exit For
    x0 = x1
Next i
SqrPN = x1
End Function
 
'-------------------------------------------------------------------------------
Public Function RacineGN(ByVal vcChiffre As String) As String
'-------------------------------------------------------------------------------
' Retourne la racine carrée très approximative d'un grand nombre Entier Positif.
' Mais ça suffit dans notre cas.
'-------------------------------------------------------------------------------
Dim Chiffre As Variant
Chiffre = Left(vcChiffre, 1) & "." & Mid(vcChiffre, 2, 12)
Chiffre = Val(Chiffre)
RacineGN = PuissanceGN(Sqr(10), Len(vcChiffre) - 1)
RacineGN = PGN(RacineGN, Sqr(CDec(Chiffre)))
End Function
 
'-------------------------------------------------------------------------------
Public Function ModGN(ByVal vcChiffre As String, ByVal Diviseur As String) As Variant
'-------------------------------------------------------------------------------
' Retourne le modulo d'un grand nombre.
'-------------------------------------------------------------------------------
Call DGN(vcChiffre, Diviseur, ModGN)
End Function
 
'---------------------------------------------------------------------------------------
Public Function CompGNrapide(ByVal b As String, ByVal a As String) As Long
'---------------------------------------------------------------------------------------
' Fait une comparaison des deux grands nombres par contrôle de cohérence pour gagner
' du temps. Si ce n'est pas possible alors lance la fonction standard CompGN().
'---------------------------------------------------------------------------------------
' Retourne : 1 si le premier nombre > le deuxième nombre
'           -1 si le premier nombre < le deuxième nombre
'            0 si les deux nombres sont égaux.
'---------------------------------------------------------------------------------------
If Left(b, 1) = "-" And Left(a, 1) <> "-" Then
    CompGNrapide = -1
ElseIf a = b Then
    CompGNrapide = 0
Else
    Select Case Len(b)
        Case Is > Len(a): CompGNrapide = 1
        Case Is < Len(a): CompGNrapide = -1
        Case Else: CompGNrapide = CompGN(b, a)
    End Select
End If
End Function
 
'---------------------------------------------------------------------------------------
Public Function PgcdGN(ByVal a As String, ByVal b As String) As String
'---------------------------------------------------------------------------------------
' Calcul le PGCD de deux grands nombres
' Variante optimisant l'Algo d'Euclide
'---------------------------------------------------------------------------------------
 
' Si la taille de a et b est petite alors utilise la fonction Pgcd2 qui est plus rapide:
If Len(a) <= 28 And Len(b) <= 28 Then
    PgcdGN = Pgcd2(CDec(a), CDec(b))
    Exit Function
End If
 
' Déclarations:
Dim R As String
 
' Validité paramètre:
a = AbsGN(a)
b = AbsGN(b)
If CompGN(a, b) = -1 Then R = b: b = a: a = R 'inverse les valeurs
 
' Calcul:
Do While CompGNrapide(AbsGN(b), "1") >= 0
    R = ModGN(a, b)
    a = b
    b = R
Loop
PgcdGN = AbsGN(a)
End Function
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------

**laurent_ott** · 13/06/2019, 14h57

Envoyé par Gorzyne

oui mais Laurent tes fonctions prennent du décimal en entrée pas du string c'est juste pas comparable !

Si c'est comparable car mes fonctions prennent bien du string en entrée.

Tu peux tester avec :
? DGN("2123487914341640748721363763898849434212102775632653001833314535451684428025884160564630174412406003395971580607230447530234280769413999637353375912165376", "187187187187187187187187187187187187187187187187")

Algorithme de division ou de modulo sur grands nombres

Algorithmes et structures de données

Discussions similaires

Partager

Partager