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
| 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:
' https://www.developpez.net/forums/d1019631/bases-donnees/ms-sql-server/developpement/probleme-utilisation-modulo/#post5686484
' 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
'---------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------- |
Partager