Bigmath - operations sur des tres grands nombres

Soyez le premier à donner votre avis sur cette source.

Vue 12 931 fois - Téléchargée 304 fois

Description

ajoute ce module dans ton projet et tu pourra utiliser les fonctions suivantes sur des nombres contenant jusqu'a 2 milliard de chiffres (stockés en string bien sur) :
- CompNumber(Number1, Number2) pour comparer 2 nombres
- SumNumber(Number1, Number2) pour additionner 2 nombres
- RoundNumber(Number, NumDigitsAfterDecimal) pour arrondir un nombre

les calculs sont en precision infinie. j'ai fait de nombreux test comparatifs pour atteindre la plus grande vitesse d'execution mais je n'ai jamais reussi a egaler la rapidite d'us_30 qui a poste un code similaire (http://www.codes-sources.com/code.aspx?ID=31544).
le code s'adapte aux options regionales et linguistiques en ce qui concerne le separateur decimal.
chaque fonction peut verifier que le nombre saisi est correct (en option dans les parametres parceque la verification d'un nombre peut etre tres longue : de l'ordre de la seconde des que le nombre depasse 200000 chiffres).

Source / Exemple :


'************************************************************************'
'************************************************************************'
'**                                                                    **'
'**                    MATHEMATICS WITH BIG NUMBERS                    **'
'**                                                                    **'
'************************************************************************'
'************************************************************************'

'----------------------------   PROPERTIES   ----------------------------'
'Author = Santiago Diez
'Date = 06 OCTOBER 2005  00:13
'Version = 3.5
'---------------------------   DESCRIPTION   ----------------------------'
'This module performs mathematic operations on very big numbers up to two
'billion digits stored as strings.
'-----------------   PUBLIC PROCEDURES AND FUNCTIONS   ------------------'
'String = CheckNumber(Number As String)
'   Returns Number in its best writting pattern or empty ("") if Number is
'   not understandable.
'-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '
'String = CreateNumber(NumberOfDigits As Long, [WithDecimal As Boolean =
'                                     True], [WithSign As Boolean = True])
'   Returns a random number with NumberOfDigits digits (including whole
'   and decimal part). CreateNumber is signed if WithSign is True, it is
'   decimal if WithDecimal is True.
'-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '
'Long = CompNumber(Number1 As String, Number2 As String, [Check As Boolean
'                                                                = False])
'   Returns -1 if Number1 < Number2,
'            0 if Number1 = Number2 and
'            1 if Number1 > Number2.
'   Check numbers if Check is True.
'-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '
'String = OppNumber(Number As String, [Check As Boolean = False])
'   Returns the opposite of Number. Check number if Check is True.
'-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '
'String = AbsNumber(Number As String, [Check As Boolean = False])
'   Returns the absolute value of Number. Check number if Check is True.
'-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '
'String = SumNumber(Number1 As String, Number2 As String, [Check As
'                                                        Boolean = False])
'   Returns Number1 + Number2. Check numbers if Check is True.
'-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '
'String = RoundNumber(Number As String, [NumDigitsAfterDecimal As Long =
'                                          0], [Check As Boolean = False])
'   Returns Number rounded to NumDigitsAfterDecimal digits after decimal.
'   Ignore if NumDigitsAfterDecimal < 0.
'---------------------------   ABOUT SPEED   ----------------------------'
'It is faster to use ByRef parameters than to use ByVal parameters.
'   That is why every public function MyFunction using ByVal parameters (
'   to ensure no parameters will be modified) has its equivalent private
'   function MyFunctionA using ByRef parameters.
'It is faster to split Number in String rather than in an Array.
'To delete a symbol in a string :
'   > String = Left$(String, Pos - 1) & Mid$(String, Pos + 1)
'   is faster than
'   > String = Replace(String, Symbol)
'-------------------------------   BUGS   -------------------------------'
'No bug reported.
'-----------------------------   SOURCES   ------------------------------'
'http://vbfrance.com/code.aspx?ID=31544     (by us_30)
'http://www.delphifr.com/code.aspx?ID=33431 (by RedDevlopper)
'-------------------------   CALLED LIBRARIES   -------------------------'
'kernel32.dll       'msvbvm60.dll
'VB6.OLB            'VB6FR.DLL
'-----------------------------   OPTIONS   ------------------------------'
Option Base 1
Option Compare Text
Option Explicit
'------------------------   PRIVATE VARIABLES   -------------------------'
Private DecSymbol As String

'+----------------------------------------------------------------------+'
'+                             DECLARATIONS                             +'
'+----------------------------------------------------------------------+'
Private Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As _
                            Long, ByVal LCType As Long, ByVal lpLCData _
                            As String, ByVal cchData As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

'+----------------------------------------------------------------------+'
'+                           CHECK FUNCTIONS                            +'
'+----------------------------------------------------------------------+'
Private Function GetLocalInfo(ByRef Id As Long) As String
    On Error Resume Next
    Dim sBuffer As String
    Dim nBufferLen As Long
    nBufferLen = 255
    sBuffer = String$(nBufferLen, vbNullChar)
    nBufferLen = _
        GetLocaleInfoA(GetSystemDefaultLCID, Id, sBuffer, nBufferLen)
    If (nBufferLen > 0) _
        Then GetLocalInfo = Left$(sBuffer, nBufferLen - 1)
End Function
Private Function GetDecSymbol() As String
    If (DecSymbol = "") _
        Then If (GetLocalInfo(&HE) = GetLocalInfo(&H16)) _
            Then DecSymbol = GetLocalInfo(&HE)
    GetDecSymbol = DecSymbol
End Function
Public Function CheckNumber(ByVal Number As String) As String
    Call CheckNumberA(Number)
    CheckNumber = Number
End Function
Private Sub CheckNumberA(Number As String)
    'Declare.
    Dim CheckNumber As String
    Dim IsNegN As Boolean
    Dim I As Byte
    'Delete all space characters.
    If InStr(Number, " ") > 0 Then Number = Replace(Number, " ", "")
    'Only one minus (-) alowed at the begining.
    IsNegN = IsNeg(Number)
    CheckNumber = Mid$(Number, 1 - IsNegN)
    'Only one point (.) or (,) alowed anywhere.
    CheckNumber = Replace(CheckNumber, GetDecSymbol, "", 1, 1)
    'There must be at least one digit.
    If CheckNumber = "" Then Exit Sub
    'There must be only digits left.
    For I = 0 To 9
        CheckNumber = Replace(CheckNumber, CStr(I), "")
    Next
    'If there is any symbol left, Number is not valid.
    If CheckNumber <> "" Then
        Number = ""
    'Else returns Number with point at the right position.
    ElseIf InStr(Number, GetDecSymbol) = 1 - IsNegN Then
        Number = IIf(IsNegN, "-0", "0") & Mid$(Number, 1 - IsNegN)
    ElseIf InStr(Number, GetDecSymbol) = Len(Number) Then
        Number = Left$(Number, Len(Number) - 1)
    End If
End Sub

'+----------------------------------------------------------------------+'
'+                           STRING FUNCTION                            +'
'+----------------------------------------------------------------------+'
Public Function CreateNumber(ByVal NumberOfDigits As Long, Optional _
                        ByVal WithDecimal As Boolean = True, Optional _
                        ByVal WithSign As Boolean = True) As String
    'Declare.
    Const SubLen As Long = 7
    Dim I As Long
    Dim IsNegN As Boolean
    Dim PointPos As Long
    'Initialize.
    Randomize
    'Make CreateNumber randomly positive or negative.
    If WithSign Then IsNegN = (Int(2 * Rnd) = 0)
    'Add decimal symbol at random position.
    If WithDecimal And NumberOfDigits > 1 _
    Then PointPos = Int((NumberOfDigits - 1) * Rnd + 2) _
    Else WithDecimal = False
    'Initialize CreateNumber.
    NumberOfDigits = NumberOfDigits - IsNegN - WithDecimal
    CreateNumber = String$(NumberOfDigits, "0")
    'Fill CreateNumber with random numbers.
    'Tip : Mid$("hello", 4, 5) = "hello" ---> "helhe"
    For I = 1 To NumberOfDigits Step SubLen
        Mid$(CreateNumber, I, SubLen) = _
            Format(Int(10 ^ SubLen * Rnd), String$(SubLen, "0"))
    Next
    'CreateNumber can't start with "0" exept if PointPos = 2.
    If PointPos <> 2 _
    Then Mid$(CreateNumber, IIf(IsNegN, 2, 1), 1) = Int(9 * Rnd + 1)
    'CreateNumber with decimal can't end with "0".
    If WithDecimal _
    Then Mid$(CreateNumber, NumberOfDigits, 1) = Int(9 * Rnd + 1)
    'Write symbols.
    If IsNegN _
    Then Mid$(CreateNumber, 1, 1) = "-"
    If WithDecimal _
    Then Mid$(CreateNumber, PointPos - IsNegN, 1) = GetDecSymbol
End Function
Private Sub AlignNumber(ByRef Number1 As String, ByRef Number2 As String _
                                    , Optional ByRef ModLen As Long = 1)
    'Declare.
    Dim IsNeg1 As Boolean, IsNeg2 As Boolean
    Dim PPos1 As Long, PPos2 As Long
    Dim WL1 As Long, WL2 As Long
    Dim DL1 As Long, DL2 As Long
    Dim WLen As Long, DLen As Long
    'Check sign.
    If IsNeg(Number1) Then IsNeg1 = True
    If IsNeg(Number2) Then IsNeg2 = True
    'Calculate whole and decimal part length.
    PPos1 = InStr(Number1, GetDecSymbol)
    PPos2 = InStr(Number2, GetDecSymbol)
    If PPos1 = 0 _
    Then DL1 = 0: WL1 = Len(Number1) + IsNeg1 _
    Else DL1 = Len(Number1) - PPos1: WL1 = PPos1 - 1 + IsNeg1
    If PPos2 = 0 _
    Then DL2 = 0: WL2 = Len(Number2) + IsNeg2 _
    Else DL2 = Len(Number2) - PPos2: WL2 = PPos2 - 1 + IsNeg2
    WLen = IIf(WL1 > WL2, WL1, WL2)
    DLen = IIf(DL1 > DL2, DL1, DL2)
    If (WLen + DLen) Mod ModLen > 0 _
    Then WLen = WLen + ModLen - (WLen + DLen) Mod ModLen
    'Align numbers.
    If WL1 < WLen Or DL1 < DLen Or (PPos1 > 0 And DLen = 0) _
    Then Number1 = IIf(IsNeg1, "-", "") _
                 & IIf(WL1 < WLen, String$(Abs(WLen - WL1), "0"), "") _
                 & Mid$(Number1, 1 - IsNeg1, WL1) _
                 & IIf(DLen > 0, GetDecSymbol & _
                   Mid$(Number1, WL1 - IsNeg1 + 2, DL1) & _
                   IIf(DL1 < DLen, String$(Abs(DLen - DL1), "0"), ""), "")
    If WL2 < WLen Or DL2 < DLen Or (PPos2 > 0 And DLen = 0) _
    Then Number2 = IIf(IsNeg2, "-", "") _
                 & IIf(WL2 < WLen, String$(Abs(WLen - WL2), "0"), "") _
                 & Mid$(Number2, 1 - IsNeg2, WL2) _
                 & IIf(DLen > 0, GetDecSymbol & _
                   Mid$(Number2, WL2 - IsNeg2 + 2, DL2) & _
                   IIf(DL2 < DLen, String$(Abs(DLen - DL2), "0"), ""), "")
End Sub
Private Sub TrimNumber(ByRef Number As String)
    'Declare.
    Dim NLead As Long
    Dim NEnd As Long
    Dim IsNegN As Boolean
    'Delete leading zeros.
    IsNegN = IsNeg(Number)
    NLead = 1 - IsNegN
    Do While Mid$(Number, NLead, 1) = "0"
        NLead = NLead + 1
    Loop
    'Delete end zeros in decimal part.
    If InStr(Number, GetDecSymbol) > 0 Then
        NEnd = Len(Number)
        Do While Mid$(Number, NEnd, 1) = "0"
            NEnd = NEnd - 1
        Loop
    Else
        NEnd = Len(Number)
    End If
    'Rewrite number.
    If NLead > 1 - IsNegN Or NEnd < Len(Number) _
    Then Number = IIf(IsNegN, "-", "") _
                & IIf(Mid$(Number, NLead, 1) = GetDecSymbol, "0", "") _
                & IIf(Mid$(Number, NLead, 1) = "", "0", "") _
                & Mid$(Number, NLead, NEnd - NLead + _
                      IIf(Mid$(Number, NEnd, 1) = GetDecSymbol, 0, 1))
End Sub

'+----------------------------------------------------------------------+'
'+                              COMPARISON                              +'
'+----------------------------------------------------------------------+'
Private Function IsNeg(ByRef Number As String) As Boolean
    IsNeg = (Left$(Number, 1) = "-")
End Function
Public Function CompNumber(ByVal Number1 As String, ByVal Number2 As _
                String, Optional ByVal Check As Boolean = False) As Long
    'Check numbers if asked to.
    If Check Then Call CheckNumberA(Number1): _
                  Call CheckNumberA(Number2): _
                  If Number1 = "" Or Number2 = "" Then Exit Function
    'Compare numbers.
    CompNumber = CompNumberA(Number1, Number2)
End Function
Private Function CompNumberA(ByVal Number1 As String, ByVal Number2 As _
                                                        String) As Long
    'Case Number1 and Number2 are negative.
    If IsNeg(Number1) And IsNeg(Number2) Then
        Call OppNumberA(Number1)
        Call OppNumberA(Number2)
        CompNumberA = CompNumberA(Number2, Number1)
    Else
        'Align numbers.
        Call AlignNumber(Number1, Number2)
        'Compare numbers.
        CompNumberA = StrComp(Number1, Number2, vbBinaryCompare)
    End If
End Function

'+----------------------------------------------------------------------+'
'+                        ADDITION / SUBTRACTION                        +'
'+----------------------------------------------------------------------+'
Public Function OppNumber(ByVal Number As String, Optional ByVal Check _
                                            As Boolean = False) As String
    If Check Then Call CheckNumberA(Number): _
                  If Number = "" Then Exit Function
    Call OppNumberA(Number)
    OppNumber = Number
End Function
Private Sub OppNumberA(ByRef Number As String)
    If IsNeg(Number) _
    Then Number = Mid$(Number, 2) _
    Else Number = ("-" & Number)
End Sub
Public Function AbsNumber(ByVal Number As String, Optional ByVal Check _
                                            As Boolean = False) As String
    If Check Then Call CheckNumberA(Number): _
                  If Number = "" Then Exit Function
    If IsNeg(Number) _
    Then AbsNumber = Mid$(Number, 2) _
    Else AbsNumber = Number
End Function
Public Function SumNumber(ByVal Number1 As String, ByVal Number2 As _
                String, Optional ByVal Check As Boolean = False) As String
    'Declare.
    Dim IsNeg1 As Boolean, IsNeg2 As Boolean
    Dim NLen1 As Long, PPos1 As Long
    Dim DecLen As Long
    Dim SumType As Long, SumNeg As Boolean
    Dim I As Long
    'All following variables must be the same data type (Bigger = Faster)
    'SubLen gives the max significant digits stored in the data type ;
    'Don't forget after addition, numbers can be one digit longer.
    Dim SubNum1 As Double, SubNum2 As Double
    Dim SubSum As Double, SubCarry As Double
    Const SubLen As Long = 14
    'Check numbers if asked to.
    If Check Then Call CheckNumberA(Number1): _
                  Call CheckNumberA(Number2): _
                  If Number1 = "" Or Number2 = "" Then Exit Function
    'Align numbers.
    Call AlignNumber(Number1, Number2, SubLen)
    'Select addition type.
    IsNeg1 = IsNeg(Number1): IsNeg2 = IsNeg(Number2)
    SumType = -IsNeg2 - 2 * IsNeg1
    'Calculate the result decimal part length.
    PPos1 = InStr(Number1, GetDecSymbol) + IsNeg1
    NLen1 = Len(Number1) + IsNeg1
    If PPos1 > 0 Then DecLen = NLen1 - PPos1
    'Delete minus and decimal symbol.
    If IsNeg1 Or PPos1 > 0 Then Number1 = _
        Mid$(Number1, 1 - IsNeg1, IIf(PPos1 > 0, PPos1 - 1, NLen1)) _
      & Mid$(Number1, PPos1 - IsNeg1 + 1, DecLen)
    If IsNeg2 Or PPos1 > 0 Then Number2 = _
        Mid$(Number2, 1 - IsNeg2, IIf(PPos1 > 0, PPos1 - 1, NLen1)) _
      & Mid$(Number2, PPos1 - IsNeg2 + 1, DecLen)
    NLen1 = NLen1 + CLng(PPos1 > 0)
    'Modify addition type if result is negative.
    Select Case SumType
        Case 1: If StrComp(Number1, Number2) = -1 _
                Then SumType = 2: SumNeg = True
        Case 2: If StrComp(Number1, Number2) = 1 _
                Then SumType = 1: SumNeg = True
        Case 3: SumType = 0: SumNeg = True
    End Select
    'Initialize Result (1 digit longer than numbers)
    SumNumber = String$(NLen1 + 1, "0")
    'Calculate sum.
    For I = NLen1 - SubLen + 1 To 1 Step -SubLen
        SubNum1 = CDec(Mid$(Number1, I, SubLen))
        SubNum2 = CDec(Mid$(Number2, I, SubLen))
        Select Case SumType
            Case 0  ' A+B
                SubSum = SubNum1 + SubNum2 + SubCarry
                SubCarry = IIf(SubSum < 10 ^ SubLen, 0, 1)
            Case 1  ' A-B
                SubSum = SubNum1 - SubNum2 + SubCarry
                SubCarry = IIf(SubSum < 0, -1, 0)
                If SubSum < 0 Then SubSum = SubSum + 10 ^ SubLen
            Case 2  '-A+B
                SubSum = -SubNum1 + SubNum2 + SubCarry
                SubCarry = IIf(SubSum < 0, -1, 0)
                If SubSum < 0 Then SubSum = SubSum + 10 ^ SubLen
        End Select
        'Insert SubSum in Result (shift -1).
        Mid$(SumNumber, I, SubLen + 1) = _
           Format(SubSum, String$(SubLen + 1, "0"))
    Next
    'Rewrite minus and decimal symbol.
    If SumNeg Or DecLen > 0 _
    Then SumNumber = IIf(SumNeg, "-", "") _
                   & Left$(SumNumber, NLen1 + 1 - DecLen) _
                   & IIf(DecLen > 0, GetDecSymbol, "") _
                   & Right$(SumNumber, DecLen)
    'Trim number.
    Call TrimNumber(SumNumber)
End Function
Public Function RoundNumber(ByVal Number As String, Optional ByVal _
                            NumDigitsAfterDecimal As Long = 0, Optional _
                            ByVal Check As Boolean = False) As String
    'Declare.
    Dim NLen As Long
    Dim DecLen As Long
    Dim NDAD As Long: NDAD = NumDigitsAfterDecimal
    'Get number lengths
    NLen = Len(Number)
    DecLen = InStr(Number, GetDecSymbol)
    If DecLen > 0 Then DecLen = NLen - DecLen
    'Check numbers if asked to.
    If Check Then Call CheckNumberA(Number): _
                  If Number = "" Then Exit Function
    'If it is not necessary to round.
    If NDAD < 0 Or NDAD >= DecLen Then
        RoundNumber = Number
    Else
       'Else round the number.
       Select Case Mid$(Number, NLen - DecLen + NDAD + 1, 1)
            Case "0", "1", "2", "3", "4"
                If NDAD = 0 _
                Then RoundNumber = Left$(Number, NLen - DecLen - 1) _
                Else RoundNumber = Left$(Number, NLen - DecLen + NDAD)
            Case "5", "6", "7", "8", "9"
                If NDAD = 0 _
                Then RoundNumber = SumNumber(Left$(Number, NLen - DecLen _
                    - 1), IIf(IsNeg(Number), "-", "") & "1", False) _
                Else RoundNumber = SumNumber(Left$(Number, NLen - DecLen _
                    + NDAD), IIf(IsNeg(Number), "-", "") & "0" & _
                    GetDecSymbol & String$(NDAD - 1, "0") & "1", False)
       End Select
    End If
    'Trim number.
    Call TrimNumber(RoundNumber)
End Function

'+----------------------------------------------------------------------+'
'+                     ACCESS TO PRIVATE FUNCTIONS                      +'
'+----------------------------------------------------------------------+'
Public Sub BigMath_GetPrivate(ByRef Name As String, Optional ByRef _
                        Number1 As String = "0", Optional ByRef Number2 _
                        As String = "0", Optional ByRef Param1 As _
                        Variant = 1, Optional ByRef Result As Variant _
                        = "0", Optional ByRef Check As Boolean = False)
    Select Case Name
        Case "AlignNumber"
            Call AlignNumber(Number1, Number2, CLng(Param1))
        Case "CompNumberA"
            Result = CompNumberA(Number1, Number2)
        Case "OppNumberA"
            Call OppNumberA(Number1)
        Case "TrimNumber"
            Call TrimNumber(Number1)
    End Select
End Sub

Conclusion :


je poste mes codes pour partager des connaissances et des idees.
j'attends des constatations de bugs ou des propositions d'amelioration.

si vous trouvez ce code inutile ou "deja vu", pas la peine de le consulter et de le commenter.
si vous eprouvez neanmoins un besoin irrepressible de montrer votre capacite a critiquer, merci de le faire en m'envoyant un message afin de ne pas noyer ce code au milieu des polemiques.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
64
les projets s'enchainent et fichtre le temps passe, j'ai toujours ca en chantier, en attente de mon interet changeant (mais c'est cyclique ^^)
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
Bonjour Renfield, et aux autres...

Est-ce que le temps est venu ? ... maintenant...

Très amicalement à tous,
Us.
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
64
Bonjour, je voulais juste signaler qu'en ce moment, je crypte...

j'ai donc, a mon tour besoin de pouvoir calculer avec de longs entiers.
dans mon code j'ai actuellement les additions/soustractions, comparaison, et quelques choses du genre.
les performances me semblent pas mal, même avec plus de 200 000 chiffres.

je posterai cela le moment venu.
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
Bonjour à tous,

J'ai étudié très attentivement (et longuement) les différentes versions déjà proposées.

=

Mais avant une réponse sur les tests. Comme déjà dit (le 8/10), j'utilise la petite routine ess() et en mode interprêté.

Pourquoi en interprêté ?
Vous me direz si je me trompe, mais pour moi, j'utilise VBA (Excel), donc mon objectif c'est d'avoir le plus rapide en mode interprêté, puisque c'est de cette façon que j'utilise les fonctions... Et bien sur, pour ceux qui utilise VB6, leur intérêt final, c'est d'avoir le plus rapide en compilé !

Les objectifs n'étant pas les mêmes, pas la peine de se lancer dans un débat stérile, comme j'ai (hélas) lu sur VBF sur le sujet...

Comme l'optimisation fine, dépends de la manière donc on veut utiliser les fonctions, je ne sais plus comment faire pour mettre tout le monde d'accord... En effet, après compilation, les classements s'en trouvent toujours un peu boulverssé...

Pour bien faire, il faut présenter les deux versions, interprêté et compilé... J'ajoute que perso, pour me guider sur l'optimisation je test en priorité en interprêté, avant un test final en compilé... A chacun de voir ! et de dire ce qui est mieux en compilé...

De plus, je ne possède pas VB6, mais VB4... alors j'espère que les classements en compilé seront conservés d'une version à l'autre... (je n'ai pas les moyens de faire mieux, désolé...)

-

Petit changement, pour la suite, j'utilise la "dll" proposé par Warny, qui donne des résultats plus stables que Timer... (bien que, tout à fait similaire en moyenne...) De plus, pour accentuer les différences, je prends maintenant dans ess() la borne 18 au lieu de 17.

=

La dernière version de Warny comporte des bugs.
"Dim t As Long, k As Long, " Virgule en trop...
La boucle IF suivante à "ElseIf" au lieu de "Else"
"offset = lenB(v) - lenB(w)" ne marche pas car v et w sont des tableaux. J'ai remplacé Len par Ubound. Ensuite, il reste encore un bug dans le calcul.

La dernière version de Renfield, ne permet pas toujours un calcul exact si les 2 nombres ont des tailles différentes. La raison vient d'un arrêt prématuré sans report de la retenue. Par exemple : 9999999 + 9 donne 19999998. Dans la version de Warny, la boucle DO sert justement à tenir compte de cette retenue.

=

J'ai essayé de reprendre les 2 versions en les simplifiant au cas d'une somme de deux nombres de même taille, puis de les optimiser pour faire une comparaison avec aussi ma version AGN (qui tient compte correctement des tailles différentes). IL me semble naturel, comme comencer par là, avant de compliquer...

Voici les listing de base (fonctionnel) :

=

Ma première version du début :

=

Function som0(n As String, m As String) As String

Dim temps As Long: temps = GetTickCount

Dim v() As Byte, w() As Byte
Dim t As Long, k As Long

v = "0" & n
w = "0" & m

k = UBound(v) - 1
For t = k To 0 Step -2
v(t) = v(t) + w(t) - 48
If v(t) > 57 Then
v(t) = v(t) - 10
v(t - 2) = v(t - 2) + 1
End If
Next t
som0 = v

MsgBox (GetTickCount - temps) / 1000
End Function

=

Version de Renfield :

=

Function BigSum0(ByRef vn1 As String, ByRef vn2 As String) As String

Dim temps As Long: temps = GetTickCount

Dim x1() As Byte, x2() As Byte
Dim i As Long, nLength2 As Long, nBuffer As Long, nRest As Long

x1 = vn1
x2 = vn2

nLength2 = UBound(x2) - 1
For i = nLength2 To 0 Step -2
nBuffer = x1(i) + x2(i) - 48 + nRest
If nBuffer > 57 Then
x1(i) = nBuffer - 10
nRest = 1
Else
x1(i) = nBuffer
nRest = 0
End If
Next i
If nRest = 0 Then
BigSum0 = x1
Else
BigSum0 = 1 & CStr(x1)
End If

MsgBox (GetTickCount - temps) / 1000
End Function

=

Ici, j'ai inclu nRest 0 dans la boucle IF> gain de temps en évitant de toujours le mettre à zéro. Les variables muettes, ont été mise en Long après plusieurs essais.

=

Version de Warny, où j'ai mis mes lignes en alternatives en remarque car la strucutre est identique.

=

Function som00(n As String, m As String) As String

Dim temps As Long: temps = GetTickCount

Dim v() As Byte, w() As Byte
Dim t As Long, k As Long, result As Long, retenue As Long

v = n
w = m

k = UBound(v) - 1
For t = k To 0 Step -2
result = v(t) + w(t) + retenue - 96 'Warny A
retenue = result \ 10 'Warny A
v(t) = (result Mod 10) + 48 'Warny A

' result = v(t) + w(t) - retenue - 96 'us B
' retenue = (result > 9) 'us B
' v(t) = (result Mod 10) + 48 'Warny B
' v(t) = result + retenue * 10 + 48 'us (alternative moins rapide)
Next t

If retenue = 0 Then 'A
som00 = v
Else
som00 = 1 & CStr(v)
End If

' If retenue Then 'B
' som00 = 1 & CStr(v)
' Else
' som00 = v
' End If

MsgBox (GetTickCount - temps) / 1000
End Function

=

Idem, ici j'ai remis les variables en Long = plus rapide. La dernière retenue a été calquée sur la version de Renfield, donnant un léger gain par rapport à :
v = "0" & n
w = "0" & m

Mon alternative avait donné en cours d'élaboration de meilleurs résultats, puis au final se rélève un poil de rien moins bien... On est ici dans l'ordre du détail, mais je vous l'indique car rien n'empêche qu'une autre petite modif puisse donner un p'tit avantage pour la suite...

=

Ma version AGN, traitant correctement les nb de tailles différentes donc fait un peu plus que les deux versions précédentes.

=

Function AGN2(ByVal nb1 As String, ByVal Nb2 As String) As String
'ADDITION DE 2 GRANDS NOMBRES ENTIERS POSITIFS

Dim temps As Long: temps = GetTickCount

'Variables
Dim Total As String, z As String
Dim V1 As Double, V2 As Double, r As Double, Ret As Long
Dim t As Long, lr As Long, Multiple As Long, L1 As Long, L2 As Long, lgmul As Long
Dim ln10 As Double

ln10 = Log(10)
z = "0"
Multiple = 14

'trouve longueurs
L1 = Len(nb1)
L2 = Len(Nb2)

'Transformation en longueur multiple de Multiple
lgmul = (IIf(L1 < L2, L2, L1) \ Multiple + 1) * Multiple
nb1 = String$(lgmul - L1, z) & nb1
Nb2 = String$(lgmul - L2, z) & Nb2

'Addition
Total = String$(lgmul, z)
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

'Boucle de recherche des zéros inutiles dans partie entière et Renvoi du résultat
For t = 1 To Len(Total)
If Mid$(Total, t, 1) <> "0" Then Exit For
Next t
AGN2 = Mid$(Total, t)
If Total "" Then AGN2 "0" 'traite le cas d'un nombre nulle

'Affichage du temps
MsgBox (GetTickCount - temps) / 1000

End Function

=

Voilà, les résultats du temps obtenu :

........|VBA.. | VB4 IDE | VB4 EXE
som0 | 6,14 | 7,8...... | 7,17
bigsum0|4,7 | 4,4...... | 3,73
som00 | 4,9 | 4,6.......| 4,22
agn2 .| 3,96 | 3,8.......| 4,16

Donc en version IDE, AGN2 est la plus rapide. Une fois compilé c'est celle de Renfield qui passe en tête. Mais il reste tout de même à leur faire tenir compte correctement des tailles différentes.

La dernière version de Warny, même si elle donne pas encore correctement le bon calcul, si les 2 nb sont de tailles différentes donne en terme de temps :

........|VBA.. | VB4 IDE | VB4 EXE
som . | 5,98 | 5,43...... | 4,80

=

Amicalement,
Us.
Messages postés
473
Date d'inscription
mercredi 7 août 2002
Statut
Membre
Dernière intervention
10 juin 2015

il y a un bug dans mon code précédent, je ne reporte pas la retenue au delà du premier chiffre du nombre le plus court :


Function som(n As String, m As String) As String

Dim v() As Byte
Dim w() As Byte
Dim t As Long, k As Long,

dim result as Integer, retenue As Integer
dim offset as long

if len(n) > len(m) then
v = "0" & n
w = m
elseif
v = "0" & m
w = n
end if

offset = lenB(v) - lenB(w) 'positif parce len(v) > len(w)

k = UBound(w) - 1
retenue = 0
For t = k To 2 Step -2
result = v(t + offset) + w(t) + retenue - 96
retenue = result \ 10
v(t + offset) = (result mod 10) + 48
Next t
t = offset
do until retenue = 0
result = v(t) + retenue - 48
retenue = result \ 10
v(t) = (result mod 10) + 48
t = t - 2
loop
som = v
End Function
Afficher les 39 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.