J'ai modifié l'algorithme, il y a quelques temps pour utiliser le concept
d'équivalence d'une chaine avec un tableau d'entier (voir le trucs & astuces sur l'analyse rapide d'un fichier pour compter les mots).
Résultat, les performances sont très rapides. Le code assembleur généré n'est pas optimisable, ou si peu !
Code : Tout sélectionner
;
; BinOctDec.pb : conversion d'un nombre de base n vers base 10 et vice versa
;
; FWeil : 20050517
;
; Les procédures indiquées ici sont particulièrement optimisées pour les conversions
; Bin2Dec , Oct2Dec et Hex2Dec, qui sont les seules utiles pour compléter les
; fonctions classiques applicables dans l'autres sens (Bin() et Hex())
;
;
; La structure OneByte est utilisée comme intermédiaire de pointage de la chaine argument des fonctions.
; Ce système d'adressage est plus rapide et efficace qu'une analyse par caractère dans une chaine.
;
Structure OneByte
a.b
EndStructure
;
; Pour les besoins historiques et pédagogiques, j'ai laissé la fonction Dec2Base, qui permet
; de convertir un décimal quelconque en chaine numérique base n.
;
; Le tableau Dec2BaseDigit est un tableau de conversion des valeurs possibles, utile pour les bases 2, 8, et 16.
; Je considère que les représentations en bases autres sont hors sujet.
;
Dim Dec2BaseDigit.s(16)
Dec2BaseDigit(0) = "0"
Dec2BaseDigit(1) = "1"
Dec2BaseDigit(2) = "2"
Dec2BaseDigit(3) = "3"
Dec2BaseDigit(4) = "4"
Dec2BaseDigit(5) = "5"
Dec2BaseDigit(6) = "6"
Dec2BaseDigit(7) = "7"
Dec2BaseDigit(8) = "8"
Dec2BaseDigit(9) = "9"
Dec2BaseDigit(10) = "A"
Dec2BaseDigit(11) = "B"
Dec2BaseDigit(12) = "C"
Dec2BaseDigit(13) = "D"
Dec2BaseDigit(14) = "E"
Dec2BaseDigit(15) = "F"
Procedure.s Dec2Base(n.l, Base.l)
RB.l
Out.s = ""
Select Base
Case 16
Out = Hex(n)
Default
Result.l = n
Res.l = 0
While Result > 0
RB = Result / Base
Res = Base * RB
Out = Dec2BaseDigit(Result - Res) + Out
Result = RB
Wend
If Out = ""
Out = "0"
EndIf
EndSelect
ProcedureReturn Out
EndProcedure
;
; Les trois procédures Dec2Hex, Dec2Oct et Dec2Bin sont laissées ici à titre indicatif.
; Elles ne sont pas d'un niveau de performances et d'optimisation très élevé.
; Dans tous les cas on peut utiliser Hex et Bin accessibles sous PureBasic.
;
Procedure.s Dec2Hex(n.l)
Res.l
R16.l
Result.l = n
Out.s = ""
While Result > 0
R16 = Result >> 4
Res = R16 << 4
Out = Dec2BaseDigit(Result - Res) + Out
Result = R16
Wend
If Out = ""
Out = "0"
EndIf
ProcedureReturn Out
EndProcedure
Procedure.s Dec2Oct(n.l)
Res.l
R8.l
Result.l = n
Out.s = ""
While Result > 0
R8 = Result >> 3
Res = R8 << 3
Out = Dec2BaseDigit(Result - Res) + Out
Result = R8
Wend
If Out = ""
Out = "0"
EndIf
ProcedureReturn Out
EndProcedure
Procedure.s Dec2Bin(n.l)
Res.l
R2.l
Result.l = n
Out.s = ""
While Result > 0
R2 = Result >> 1
Res = 2 * R2
Out = Dec2BaseDigit(Result - Res) + Out
Result = R2
Wend
If Out = ""
Out = "0"
EndIf
ProcedureReturn Out
EndProcedure
;
; Voici les procédures intéressantes. C'est concis et dense.
; J'ai séparé les trois bases dans trois procédures, pour optimiser les performances (on pourrait
; généraliser l'algorithme pour une base n avec un argument d'appel supplémentaire).
;
; On commence par Bin2Dec
;
; Pour chaque caractère de la chaine binaire passée en argument
; Le résultat est ajouté à lui-même après décalage à gauche d'une position binaire
;
; Par équivalence d'adresse mémoire, on considère que la chaine argument correspond
; à un tableau d'octets. Les caractères de la chaine sont des chiffres alignés à gauche.
;
; De ce fait on peut considérer que le premier caractère est le poids le plus élevé.
;
; En vertu de ce principe, je prends la valeur du premier caractère (soit *t\a - 48);
; ajouté au résultat courant décalé à gauche.
;
; Lors du premier décalage le résultat initialisé à 0 est décalé à gauche dans le vide.
; La valeur du code *t\a - 48 lui est ajoutée.
;
; On ajoute 1 à l'adresse *t.Ce qui fait que l'on pointera le prochain caractère de la chaine au travers de *t\a
;
; Au tour suivant, on lit le "bit suivant" de la chaine et on l'ajoute après avoir décalé le résultat à gauche de 1 bit.
; Donc on a multiplié le résultat par 2 puis ajouté la valeur du bit suivant, et ainsi de suite, jusqu'à ce que le code
; lu dans la chaine soit un 0. Comme les chaines de caractères se termine toujours par un 0, on est sur d'être
; arrivé au bout.
;
; CQFD
;
Procedure Bin2Dec(BinaryStringNumber.s)
*t.OneByte = @BinaryStringNumber
Result.l = 0
While *t\a <> 0
Result = (Result << 1) + (*t\a - 48)
*t + 1
Wend
ProcedureReturn Result
EndProcedure
;
; Pour la procédure Oct2Dec on procède de la même manière sauf que chaque décalage est de trois bits
; La valeur octale de chaque caractère lu reste la valeur ASCII du code de la chaine - 48. Car les codes ASCII
; des chiffres de 0 à 9 vont respoectivement de 48 à 57.
;
Procedure Oct2Dec(OctalStringNumber.s)
*t.OneByte = @OctalStringNumber
Result.l = 0
While *t\a <> 0
Result = (Result << 3) + (*t\a - 48)
*t + 1
Wend
ProcedureReturn Result
EndProcedure
;
; Pour la procédure Hex2Dec, il s'agit du même algorithme, sauf un truc particulier :
; Les caractères utilisés pour représenter une chaine hexadécimale sont 0-9 et A-F.
; La valeur ASCII de A qui vaut 10 en hexa est 65. La valeur ASCII de 9 est 57.
; Comme ces caractères ne sont pas contigus on ne peut pas exactement traiter les codes
; de la même manière.
;
; Il y a donc un traitement particulier pour les codes de la chaine, en regardant si chaque caractère est
; compris entre 0 et 9, ou entre A et F.
;
; De plus, je me suis permi, ça ne coûte pas beaucoup plus cher, de traiter les cas où la chaine hexadécimale
; contient des minuscules. Allez soyons généreux.
;
Procedure Hex2Dec(HexNumber.s)
*t.OneByte = @HexNumber
Result.l = 0
While *t\a <> 0
If *t\a >= '0' And *t\a <= '9'
Result = (Result << 4) + (*t\a - 48)
ElseIf *t\a >= 'A' And *t\a <= 'F'
Result = (Result << 4) + (*t\a - 55)
ElseIf *t\a >= 'a' And *t\a <= 'f'
Result = (Result << 4) + (*t\a - 87)
Else
Result = (Result << 4) + (*t\a - 55)
EndIf
*t + 1
Wend
ProcedureReturn Result
EndProcedure
;
; Programme principal pour tester les procédures
;
DecConst.l
BinConst.s
OctConst.s
HexConst.s
OpenConsole()
DecConst = 16434824
BinConst = "111110101100011010001000"
OctConst = "76543210"
HexConst = "FAC688"
PrintN("Dec2Base(n,2) : Dec2Base(" + Str(DecConst) + ",2) =" + Dec2Base(DecConst, 2))
PrintN("Dec2Bin(n) : Dec2Bin(" + Str(DecConst) + ") =" + Dec2Bin(DecConst))
PrintN("Dec2Base(n, 8): Dec2Base(" + Str(DecConst) + ", =" + Dec2Base(DecConst, 8))
PrintN("Dec2Oct(n) : Dec2Oct(" + Str(DecConst) + ") =" + Dec2Oct(DecConst))
PrintN("Dec2Base(n,16) : Dec2Base(" + Str(DecConst) + ",16)=" + Dec2Base(DecConst, 16))
PrintN("Dec2Hex(n) : Dec2Hex(" + Str(DecConst) + ") =" + Dec2Hex(DecConst))
PrintN("Hex(n) : Hex(" + Str(DecConst) + ") =" + Hex(DecConst))
PrintN("Bin2Dec(n) : Bin2Dec(" + BinConst + ") =" + Str(Bin2Dec(BinConst)))
PrintN("Oct2Dec(n) : Oct2Dec(" + OctConst + ") =" + Str(Oct2Dec(OctConst)))
PrintN("Hex2Dec(n) : Hex2Dec(" + HexConst + ") =" + Str(Hex2Dec(HexConst)))
PrintN("Hex2Dec2(n) : Hex2Dec2(" + HexConst + ") =" + Str(Hex2Dec(HexConst)))
;
; et pour le plaisir ....
;
PrintN(Str(Hex2Dec(Dec2Hex(123456789))))
PrintN(Str(Oct2Dec(Dec2Oct(123456789))))
PrintN(Str(Bin2Dec(Dec2Bin(123456789))))
Count = 1000000
tz = GetTickCount_() : For i = 1 To Count
Result = Hex2Dec(HexConst)
Next : PrintN(Str(GetTickCount_() - tz) + " " + Str(Result))
tz = GetTickCount_() : For i = 1 To Count
Result = Oct2Dec(OctConst)
Next : PrintN(Str(GetTickCount_() - tz) + " " + Str(Result))
tz = GetTickCount_() : For i = 1 To Count
Result = Bin2Dec(BinConst)
Next : PrintN(Str(GetTickCount_() - tz) + " " + Str(Result))
;
; Une manière de tester le fonctionnement
;
For i = 1 To Count
If Hex2Dec(Hex(i)) <> i
PrintN("Y a un bug avec : " + Str(i))
Bug = #TRUE
EndIf
Next
If Bug
PrintN( "Arf !")
Else
PrintN("Lol !")
EndIf
While Inkey() = ""
Wend
CloseConsole()
End
