PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Cherche Optimisation Système Bibi-Binaire

https://www.purebasic.fr/french/viewtopic.php?t=15871

Page 1 sur 2

Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 7:37
par Shadow
Salut,

Mon système Bibi-Binaire est largement beaucoup trop long.
J'ai essayé d'optimiser le plus possible, bien que 10 fois plus rapide...

Ainsi les résultat sont mieux mais encore plus de 10x trop long de trop par apport à Hex().
Utiliser la mémoire est un bon moyen d'optimiser ces routines mais c'est un travail assez complexe...

J'aurais besoin svp de votre aide pour me dire comment je dois m'y prendre.
Ceci me conviens pas, trop lent, ya qu'a rien qu'à voir ce code là pour s'en rendre compte:

Code : Tout sélectionner

*MemoireID = AllocateMemory(32)
If *MemoireID
  
A = ElapsedMilliseconds()
For I = 1 To 10000000
  PokeS(*MemoireID, Hex(I))
Next
B = ElapsedMilliseconds() - A

Debug B

Else
  Debug "Impossible d'allouer la mémoire demandée !"
EndIf
Hex() est très optimisé et rapide.

Ici, voyez, boucle 10 (1 000 000 au lieux de 10 000 000) fois moins
longue et prends plus de temps quand même !:

Code : Tout sélectionner

; Code crée par Monsieur Dieppedalle David le 09/03/2016.
; Système Hexadécimale Bibi-binaire.

Global *MemoireIDChaineHexadecimalBibiBinaire = AllocateMemory(32)

If *MemoireIDChaineHexadecimalBibiBinaire
  PokeS(*MemoireIDChaineHexadecimalBibiBinaire, "HOHAHEHIBOBABEBIKOKAKEKIDODADEDI", 32, #PB_Ascii)
Else
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Global *MemoireIDChaineSortie = AllocateMemory(32)

If *MemoireIDChaineSortie

Else
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Global *MemoireIDChaineSortieTemps = AllocateMemory(32)

If *MemoireIDChaineSortieTemps

Else
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Procedure.s DecimalToBibiBinaire(Nombre.q)
  
  Repeat
    
    Division.q = Nombre.q / 16
    Reste.q = Nombre.q - (Division.q * 16)
    
    PokeS(*MemoireIDChaineSortie + PositionEcriture.i, PeekS(*MemoireIDChaineHexadecimalBibiBinaire + (Reste.q * 2), 2, #PB_Ascii))
    PositionEcriture.i + 2
    
    Nombre.q = Division.q
    
  Until Division.q < 16
  
  If Division.q > 0
    PokeS(*MemoireIDChaineSortie + PositionEcriture.i, PeekS(*MemoireIDChaineHexadecimalBibiBinaire + (Division.q * 2), 2, #PB_Ascii))
  EndIf
  
  ; Met la chaîne à l'envert
  If PositionEcriture.i > 2
    
    For I = PositionEcriture.i To 0 Step -2
      PokeS(*MemoireIDChaineSortieTemps + PositionEcriture2.i, PeekS(*MemoireIDChaineSortie + I, 2, #PB_Ascii), 2, #PB_Ascii)
      PositionEcriture2.i + 2
    Next
    
    ProcedureReturn PeekS(*MemoireIDChaineSortieTemps)
    
  Else
    ProcedureReturn PeekS(*MemoireIDChaineSortie)
    
  EndIf

EndProcedure

A = ElapsedMilliseconds()
For I = 1 To 1000000
DecimalToBibiBinaire(I)
Next
B = ElapsedMilliseconds() - A
Debug B

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 9:15
par Shadow
Plus simple avec un tableau mais met 2x plus de temps !

Code : Tout sélectionner

; Code crée par Monsieur Dieppedalle David le 09/03/2016.
; Système Hexadécimale Bibi-binaire.

; La chaîne Bibi-binaire.
ChaineHexadecimalBibiBinaire$ = "HO.HA.HE.HI.BO.BA.BE.BI.KO.KA.KE.KI.DO.DA.DE.DI"

; Pour stoquer la chaîne Bibi-binaire.
Global Dim TableauBibiBinaire.s(15)

; Pour stoquer la chaîne Bibi-binaire de sortie.
Global Dim TableauBibiBinaireSortie.s(15)

; Remplissage du tableau avec les valeurs Bibi-binaire.
For I = 0 To 15
  TableauBibiBinaire.s(I) = StringField(ChaineHexadecimalBibiBinaire$, I + 1, ".")
Next

Procedure.s DecimalToBibiBinaire(Nombre.q)
  
  ChaineSortieBibibinaire$ = ""
  IndexTableauBibiBinaireSortie.i = 15
    
  Repeat
    
    Division.q = Nombre.q / 16
    Reste.q = Nombre.q - (Division.q * 16)
    
    TableauBibiBinaireSortie.s(IndexTableauBibiBinaireSortie.i) = TableauBibiBinaire.s(Reste.q)
    IndexTableauBibiBinaireSortie.i - 1
    
    Nombre.q = Division.q
    
  Until Division.q < 16
  
  If Division.q > 0
    TableauBibiBinaireSortie.s(IndexTableauBibiBinaireSortie.i) = TableauBibiBinaire.s(Division.q)
  EndIf
  
  ; Créer la chaine de sortie.
  For I = 0 To 15
    ChaineSortieBibibinaire$ + TableauBibiBinaireSortie.s(I)
  Next
  
  ProcedureReturn ChaineSortieBibibinaire$
  
EndProcedure

A = ElapsedMilliseconds()
For I = 1 To 1000000
DecimalToBibiBinaire(I)
Next
B = ElapsedMilliseconds() - A
Debug B

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 10:28
par Shadow
Version un peut plus rapide que juste au dessus avec le tableau, mais encore bien trop lent:

Code : Tout sélectionner

; Code crée par Monsieur Dieppedalle David le 09/03/2016.
; Système Hexadécimale Bibi-binaire.

Global *MemoireIDChaineHexadecimalBibiBinaire = AllocateMemory(32)

If Not *MemoireIDChaineHexadecimalBibiBinaire
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Global *MemoireIDChaine = AllocateMemory(16)

If Not *MemoireIDChaine
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Procedure.s DecimalToBibiBinaire(Nombre.q)
  
  FillMemory(*MemoireIDChaine, 16)
  FillMemory(*MemoireIDChaineHexadecimalBibiBinaire, 32)
  
  Nombre$ = Hex(Nombre.q)
  
  LongueurHex.i = Len(Nombre$)
  PokeS(*MemoireIDChaine, Nombre$)
  
  For Index.i = 0 To LongueurHex.i - 1
    
    Select PeekS(*MemoireIDChaine + Index.i, 1)
        
      Case "0"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "HO")
        
      Case "1"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "HA")
        
      Case "2"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "HE")
        
      Case "3"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "HI")
        
      Case "4"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "BO")
        
      Case "5"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "BA")
        
      Case "6"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "BE")
        
      Case "7"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "BI")
        
      Case "8"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "KO")
        
      Case "9"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "KA")
        
      Case "A"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "KE")
        
      Case "B"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "KI")
        
      Case "C"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "DO")
        
      Case "D"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "DA")
        
      Case "E"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "DE")
        
      Case "F"
        PokeS(*MemoireIDChaineHexadecimalBibiBinaire, PeekS(*MemoireIDChaineHexadecimalBibiBinaire) + "DI")

    EndSelect
    
  Next
  
  ProcedureReturn PeekS(*MemoireIDChaineHexadecimalBibiBinaire)
  
EndProcedure

; Debug DecimalToBibiBinaire(9223372036854775807)

A = ElapsedMilliseconds()
For I = 1 To 1000000
  DecimalToBibiBinaire(i)
Next
B = ElapsedMilliseconds() - A
Debug B
Si vous pouviez m'aider svp :)

Note: il serra je pense impossible d'être plus rapide ou égale à la vitesse de Hex().
Rien que la procédure vide dans la boucle met env 250 millisecondes, ont dépasse déjà la commande Hex() à elle seule.

Code : Tout sélectionner

A = ElapsedMilliseconds()
For I = 1 To 1000000
  Hex(i)
Next
B = ElapsedMilliseconds() - A
Debug B
Met entre 100 et 200 millisecondes, c'est tout :!:

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 19:08
par Shadow
Merci dobro :)

Cependant ta méthode est largement encore pire que les miennes sans vouloir te vexer :|

Code : Tout sélectionner

A = ElapsedMilliseconds()
For I = 1 To 1000000
Decimal2BIBI(I)
Next
B = ElapsedMilliseconds() - A

Debug "Temps :" + Str(B)
Met rien que là 10 seconde chez moi contre env 2 secondes pour mon dernier code !

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 19:22
par Ar-S
Shadow pour toute mesure d’exécution d'un prog, désactive toujours le debugger et affiche ton resultat dans un messagerequester()

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 19:27
par Shadow
Ceci ne change rien au problème !

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 20:04
par Shadow
Comment fonctionne la commande Hex().
Comment elle fait pour être aussi rapide ? :?

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 21:27
par Shadow
Voici la suite:

Code : Tout sélectionner

; Code crée par Monsieur Dieppedalle David le 09/03/2016 sur la base d'un code de Gally HC.
; Système Hexadécimale Bibi-binaire.

Procedure.s DecimalToBibiBinaire(Nombre.q)

  ChaineHexadecimalBibiBinaire$ = "HO.HA.HE.HI.BO.BA.BE.BI.KO.KA.KE.KI.DO.DA.DE.DI"
  ChaineHexadecimal$ = Hex(Nombre.q)
  LongueurChaineHexadecimal = Len(ChaineHexadecimal$)
  
  For Index = 1 To LongueurChaineHexadecimal
    ChaineSortie$ + StringField(ChaineHexadecimalBibiBinaire$, Val("$" + Mid(ChaineHexadecimal$, Index, 1)) + 1, ".")
  Next
   
  ProcedureReturn ChaineSortie$
  
EndProcedure

; Debug DecimalToBibiBinaire(9223372036854775807)

A = ElapsedMilliseconds()

For i = 1 To 1000000
  a$ = DecimalToBibiBinaire(9223372036854775807)
Next

B = ElapsedMilliseconds() - A

Debug B
Debug a$

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 21:27
par Shadow
La plus rapide à ce jour:

Code : Tout sélectionner

; Code crée par Monsieur Dieppedalle David le 09/03/2016.
; Système Hexadécimale Bibi-binaire.

; Principe largement amélioré avec l'aide de Gally HC sur la base de son code.
; Utilisation de la mémoire par moi même.

; Version la plus rapide à ce jour !

Global *MemoireIDChaineHexadecimalBibiBinaire = AllocateMemory(32 + 1)

If Not *MemoireIDChaineHexadecimalBibiBinaire
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

PokeS(*MemoireIDChaineHexadecimalBibiBinaire, "HOHAHEHIBOBABEBIKOKAKEKIDODADEDI")

Global *MemoireIDChaineHexadecimal = AllocateMemory(16 + 1)

If Not *MemoireIDChaineHexadecimal
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Global *MemoireIDChaineSortie = AllocateMemory(32 + 1)

If Not *MemoireIDChaineSortie
  Debug "Impossible d'allouer la mémoire demandée !"
  End
EndIf

Procedure.s DecimalToBibiBinaire(Nombre.q)
  
  ChaineHexadecimal$ = Hex(Nombre.q)
  LongueurChaineHexadecimal.i = Len(ChaineHexadecimal$)
  Position.i = 0
  
  FillMemory(*MemoireIDChaineHexadecimal, 16 + 1, 0, #PB_Ascii)
  FillMemory(*MemoireIDChaineSortie, 32 + 1, 0, #PB_Ascii)
  
  PokeS(*MemoireIDChaineHexadecimal, ChaineHexadecimal$, -1, #PB_Ascii)
  
  For Index.i = 1 To LongueurChaineHexadecimal.i
    PokeS(*MemoireIDChaineSortie + Position.i, PeekS(*MemoireIDChaineHexadecimalBibiBinaire + (Val("$" + PeekS(*MemoireIDChaineHexadecimal + Index.I - 1, 1, #PB_Ascii)) * 2), 2, #PB_Ascii))
    Position.i + 2
  Next
  
  ChaineSortie$ = PeekS(*MemoireIDChaineSortie, -1, #PB_Ascii)
  
  ProcedureReturn ChaineSortie$
EndProcedure

; Debug DecimalToBibiBinaire(9223372036854775807)

A = ElapsedMilliseconds()

For i = 1 To 1000000
  a$ = DecimalToBibiBinaire(9223372036854775807)
Next

B = ElapsedMilliseconds() - A

Debug B
Debug a$

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 21:32
par Shadow
Spock, bon code mais encore largement trop lent :wink:

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 22:46
par GallyHC
Salut Shadow,

A voir ton résultat tu as "IHIHIHIHIHIHIHIHO" avec comme valeur "9223372036854775807", alors que moi avec :

Code : Tout sélectionner

EnableExplicit

Procedure.s Decimal2BIBI(qvalue.q)
  Define.s sresult
  Define.s BibiBinaire  = "HO,HA,HE,HI,BO,BA,BE,BI,KO,KA,KE,KI,DO,DA,DE,DI"
  Define.s svalue       = Hex(qvalue)
  Define.i i, iqvlen    = Len(svalue)
  For i=1 To iqvlen
    sresult + StringField(BibiBinaire, Val("$" + Mid(svalue,i,1)) + 1, ",")
  Next i
  ProcedureReturn sresult
EndProcedure

Procedure.s Decimal2BIBIVal(qvalue.q)
  Define.s sresult
  Define.s BibiBinaire  = "HOHAHEHIBOBABEBIKOKAKEKIDODADEDI"
  Define.s svalue       = Hex(qvalue)
  Define.i i, iqvlen    = Len(svalue)
  For i=1 To iqvlen
    sresult + Mid(BibiBinaire, ((Val("$" + Mid(svalue,i,1)) ) * 2) + 1, 2)
  Next i
  ProcedureReturn sresult
EndProcedure

Define.s sres
Define.i i, A, B = ElapsedMilliseconds()
For i=0 To 1000000
  sres = Decimal2BIBI(9223372036854775807)
Next i
A = ElapsedMilliseconds() - B

Debug sres
Debug A
Debug "-----------------"

B = ElapsedMilliseconds()
For i=0 To 1000000
  sres = Decimal2BIBIVal(9223372036854775807)
Next i
A = ElapsedMilliseconds() - B
Debug sres
Debug A
J'ai "BIDIDIDIDIDIDIDIDIDIDIDIDIDIDIDI" et en testant le code de spock, j'ai la même chose. Je penses que tu as un problème de lecture dans ton accès mémoire.

Cordialement,
GallyHC

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 22:57
par Shadow
Faut tester en 64 bits pas 32 xd.
Je défis quelqu'un de faire plus rapide ! :wink:

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 23:05
par GallyHC
Je précise pb ver: 5.42 LTS.

GallyHC

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 23:38
par Shadow
Mise à jour faite.
Fonctionne en 32 et 64 bits version 5.42 LTS.

Re: Cherche Optimisation Système Bibi-Binaire

Publié : mer. 09/mars/2016 23:46
par falsam
@Shadow: Précise quand il faut compiler en unicode, sinon le résultat est faux :wink:

Précise que c'est ce code qui est mise à jour : http://www.purebasic.fr/french/viewtopi ... 05#p181405

Il y a un IMA avec la prise en charge unicode.
Fuseau horaire sur UTC+01:00
Page 1 sur 2

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru