PureBasic

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

...............

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

Page 1 sur 1

...............

Publié : ven. 15/mai/2009 12:11
par Backup
hum ..

Publié : mar. 19/mai/2009 12:20
par Backup
Merci :)

j'ai donc ajouté la meme procedure en mode non recursif
dans la premiere page ! :)
et j'ai modifié le mode librairie :)

j'en ai profité pour nettoyer le topic
puisque les interventions, n'avaient plus de rapport avec mon code modifié
puisque grâce a vous, je l'ai fait évoluer , Merci donc a vous :)

Publié : mar. 19/mai/2009 13:43
par Le Soldat Inconnu
J'arrive après la bataille mais bon

c'est pas plus simple comme cela ? :roll:
j'espère faire exactement la même chose mais je pense que oui

Code : Tout sélectionner

Procedure.s Remplace_Mot(Texte.s, MotCherche.s, MotRemplace.s)
  Protected Recherche, LongueurCherche, LongueurRemplace, Caractere.s
  Longueur = Len(MotCherche)
  LongueurRemplace = Len(MotRemplace)
  Repeat
    Recherche = FindString(Texte, MotCherche, Recherche)
    If Recherche > 0
      Caractere = Mid(Texte, Recherche + Longueur, 1)
      Recherche - 1
      If (Caractere < "0" Or Caractere > "9") And (Caractere < "A" Or Caractere > "Z") And (Caractere < "a" Or Caractere > "z")
        If Recherche > 0
          Caractere = Mid(Texte, Recherche, 1)
        EndIf
        If Recherche = 0 Or ((Caractere < "0" Or Caractere > "9") And (Caractere < "A" Or Caractere > "Z") And (Caractere < "a" Or Caractere > "z"))
          Texte = Left(Texte, Recherche) + MotRemplace + Right(Texte, Len(Texte) - Recherche - Longueur)
          Recherche + LongueurRemplace - Longueur
        EndIf
      EndIf
      Recherche + 2
    EndIf
  Until Recherche = 0
  ProcedureReturn Texte
EndProcedure

Texte.s ="Bonjour, je suis le bon bonbon contre les caries de suisse"
Texte = Remplace_Mot(Texte, "bon", "tres bon")
Texte = Remplace_Mot(Texte, "suis", "mange")
Debug Texte
j'ai fait un test de vitesse
ça me donne
LSI = 266 ms
Dobro Récursif = 15359 ms
Dobro non récursif = 5313 ms

Je suis pénible hein ? :lol:

voici le code du test

Code : Tout sélectionner

Procedure.s Remplace_Mot(Texte.s, MotCherche.s, MotRemplace.s)
  Protected Recherche, LongueurCherche, LongueurRemplace, Caractere.s
  Longueur = Len(MotCherche)
  LongueurRemplace = Len(MotRemplace)
  Repeat
    Recherche = FindString(Texte, MotCherche, Recherche)
    If Recherche > 0
      Caractere = Mid(Texte, Recherche + Longueur, 1)
      Recherche - 1
      If (Caractere < "0" Or Caractere > "9") And (Caractere < "A" Or Caractere > "Z") And (Caractere < "a" Or Caractere > "z")
        If Recherche > 0
          Caractere = Mid(Texte, Recherche, 1)
        EndIf
        If Recherche = 0 Or ((Caractere < "0" Or Caractere > "9") And (Caractere < "A" Or Caractere > "Z") And (Caractere < "a" Or Caractere > "z"))
          Texte = Left(Texte, Recherche) + MotRemplace + Right(Texte, Len(Texte) - Recherche - Longueur)
          Recherche + LongueurRemplace - Longueur
        EndIf
      EndIf
      Recherche + 2
    EndIf
  Until Recherche = 0
  ProcedureReturn Texte
EndProcedure

Procedure.s   dobro_replace(chaine$,chaine_cherche$,chaine_remplace$)
  ; by Dobro
  Static extrait1$,pos
  If pos= Len (chaine$)
    text2$=extrait1$
    pos=0 :extrait1$= ""
    ProcedureReturn text2$
  EndIf
  pos=pos+1
  extrait1$=extrait1$+ Mid (chaine$,pos,1)
  car_avant= Asc ( Mid (chaine$,pos-1,1)) ; le caractere avant
  car_apres= Asc ( Mid (chaine$,pos+ Len (chaine_cherche$),1)) ; ) ; le caractere apres
  extrait3$= Mid (chaine$,pos, Len (chaine_cherche$)) ; la chaine extraite
  
  If extrait3$=chaine_cherche$
    If (car_apres<48 Or (car_apres>57 And car_apres<65) Or (car_apres>90 And car_apres<97) Or car_apres>122 )
      If pos>1
        If (car_avant<48 Or (car_avant>57 And car_avant<65) Or (car_avant>90 And car_avant<97) Or car_avant>122 )
          extrait1$= Left (extrait1$, Len (extrait1$)-1)
          extrait1$=extrait1$+chaine_remplace$
          pos=pos+ Len (chaine_cherche$)-1
        EndIf
      Else
        extrait1$= Left (extrait1$, Len (extrait1$)-1)
        extrait1$=extrait1$+chaine_remplace$
        pos=pos+ Len (chaine_cherche$)-1
      EndIf
    EndIf
  EndIf
  text2$=dobro_replace(chaine$,chaine_cherche$,chaine_remplace$)
  ProcedureReturn text2$
EndProcedure
ProcedureDLL.s   dobro_replace2(chaine$,chaine_cherche$,chaine_remplace$)
  ; by Dobro
  For pos=1 To Len (chaine$)
    extrait1$=extrait1$+ Mid (chaine$,pos,1)
    car_avant= Asc ( Mid (chaine$,pos-1,1)) ; le caractere avant
    car_apres= Asc ( Mid (chaine$,pos+ Len (chaine_cherche$),1)) ; ) ; le caractere apres
    extrait3$= Mid (chaine$,pos, Len (chaine_cherche$)) ; la chaine extraite
    
    If extrait3$=chaine_cherche$
      If (car_apres<48 Or (car_apres>57 And car_apres<65) Or (car_apres>90 And car_apres<97) Or car_apres>122 )
        If pos>1
          If (car_avant<48 Or (car_avant>57 And car_avant<65) Or (car_avant>90 And car_avant<97) Or car_avant>122 )
            extrait1$= Left (extrait1$, Len (extrait1$)-1)
            extrait1$=extrait1$+chaine_remplace$
            pos=pos+ Len (chaine_cherche$)-1
          EndIf
        Else
          extrait1$= Left (extrait1$, Len (extrait1$)-1)
          extrait1$=extrait1$+chaine_remplace$
          pos=pos+ Len (chaine_cherche$)-1
        EndIf
      EndIf
    EndIf
  Next pos
  
  text2$=extrait1$
  pos=0 :extrait1$= ""
  ProcedureReturn text2$
EndProcedure 



Texte.s ="Bonjour, je suis le bon bonbon contre les caries de suisse"

Temps = ElapsedMilliseconds()
For n = 1 To 50000
  Texte_LSI.s = Remplace_Mot(Texte, "bon", "tres bon")
  Texte_LSI = Remplace_Mot(Texte_LSI, "suis", "mange")
Next
Temps_LSI = ElapsedMilliseconds() - Temps

Temps = ElapsedMilliseconds()
For n = 1 To 50000
  Texte_Dobro.s = dobro_replace(Texte, "bon", "tres bon")
  Texte_Dobro = dobro_replace(Texte_Dobro, "suis", "mange")
Next
Temps_Dobro = ElapsedMilliseconds() - Temps

Temps = ElapsedMilliseconds()
For n = 1 To 50000
  Texte_Dobro2.s = dobro_replace2(Texte, "bon", "tres bon")
  Texte_Dobro2 = dobro_replace2(Texte_Dobro2, "suis", "mange")
Next
Temps_Dobro2 = ElapsedMilliseconds() - Temps

MessageRequester("Temps", Texte + Chr(10) + Texte_LSI + Chr(10) + "LSI = " + Str(Temps_LSI) + Chr(10) + Texte_Dobro + Chr(10) + "Dobro récursif = " + Str(Temps_Dobro) + Chr(10) + Texte_Dobro2 + Chr(10) + "Dobro non récursif = " + Str(Temps_Dobro2))

Publié : mar. 19/mai/2009 13:54
par Le Soldat Inconnu
j'ai remis une petite couche d'optimisation, je suis tombée de 360 ms à 266 ms

j'ai mis à jour le code plus haut

Publié : mar. 19/mai/2009 13:56
par Backup
oui bien sur

je n'avais pas voulu employer "FindString() "

mais je savais que c'etait optimisable :)

c'est clair que les "saut" obtenue par findstring() apporte le turbo par rapport a
mon analyse "glissante" de la phrase d'origine !

c'est bien ! ,et tu n'est pas penible du tout :)

je suis deja bien content d'etre arrivé a faire ça :lol:
je trouve que ça devrai etre installé d'office dans la librairie Strings
de purebasic !!

car la fonction actuelle , est plutot con !! :lol:
Merci pour ta contribution :)

Publié : mar. 19/mai/2009 14:00
par Le Soldat Inconnu
J'ai encore modifier un petit truc, code remis à jour :)

Après, pour aller plus vite, à mon avis, il faut directement travailler en pointeur sur la zone mémoire du string.
mais ça va compliquer pour pas grand chose je pense

Publié : mar. 19/mai/2009 16:27
par gnozal
Encore une autre variante !

Code : Tout sélectionner

Structure MemoryArray 
  Byte.c[0] 
EndStructure 
Global Dim AllowedChar.c(255)
For i = '0' To '9'
  AllowedChar(i) = 1
Next
For i = 'A' To 'Z'
  AllowedChar(i) = 1
Next
For i = 'a' To 'z'
  AllowedChar(i) = 1
Next
Procedure.s Remplace_Mot_Variante(Texte.s, MotCherche.s, MotRemplace.s) 
  Protected Recherche, LongueurCherche, LongueurRemplace
  Protected *Texte.MemoryArray
  Longueur = Len(MotCherche) 
  LongueurRemplace = Len(MotRemplace) 
  *Texte = @Texte
  Repeat 
    Recherche = FindString(Texte, MotCherche, Recherche) 
    If Recherche
      If AllowedChar(*Texte\Byte[Recherche + Longueur - 1]) = 0
        If Recherche = 1 Or (AllowedChar(*Texte\Byte[Recherche - 2]) = 0) 
          Texte = Left(Texte, Recherche - 1) + MotRemplace + Right(Texte, Len(Texte) - Recherche - Longueur + 1) 
          Recherche + LongueurRemplace - Longueur 
        EndIf 
      EndIf 
      Recherche + 2 
    EndIf 
  Until Recherche = 0 
  ProcedureReturn Texte 
EndProcedure
Pas vraiment beaucoup testé mais çà à l'air de tenir la route.

Publié : mar. 19/mai/2009 18:10
par Backup
oui elle marche bien :D


faudrai persuader Fred d'inclure ceci dans la librairie string de future version de purebasic

je viens de faire une demande sur le forum anglais
on verra bien

je verrai bien un nom de fonction style replace_exact() ou un truc du genre :)


FRED si tu passe par là ?

comment ça ? dans mes reves ? :lol:

croyez vous qu'il faille un sondage ??



petite explication de ce que fait nos procedure


explication :

cette fonction remplace l'expression exacte par une autre

exemple :


Text$ = "aa Test_Procedure20(coucou) bb Test_Procedure205 (coucou) cc Test_Procedure20 (coucou) cc Test_Procedure20 totoProcedure20" + Chr (13)+ Chr (10)+ "(coucou)"

Debug dobro_replace(Text$, "Procedure20" , "xxx" )
Citation:

donnera :
aa Test_xxx(coucou) bb Test_Procedure205 (coucou) cc Test_xxx (coucou) cc Test_xxx totoProcedure20
(coucou)



seul le mot procedure20 a ete changé !!
cette procédure ne change pas le mot s'il est précédé ou suivi d'une lettre ou d'un chiffre , ce qui garanti la modification du mot exact seul !!
même si celui ci est précédé ou suivi d'un signe de ponctuation !!!

Publié : mar. 19/mai/2009 22:04
par Progi1984
Et Gnozal remporte la palme :

Code : Tout sélectionner

Bonjour, je suis le bon bonbon contre les caries de suisse
Bonjour, je mange le tres bon bonbon contre les caries de suisse
LSI = 694
Bonjour, je mange le tres bon bonbon contre les caries de suisse
Dobro récursif = 22205
Bonjour, je mange le tres bon bonbon contre les caries de suisse
Dobro non récursif = 7839
Bonjour, je mange le tres bon bonbon contre les caries de suisse
Gnozal = 536

Code : Tout sélectionner

Procedure.s Remplace_Mot(Texte.s, MotCherche.s, MotRemplace.s)
	Protected Recherche, LongueurCherche, LongueurRemplace, Caractere.s
	Longueur = Len(MotCherche)
	LongueurRemplace = Len(MotRemplace)
	Repeat
		Recherche = FindString(Texte, MotCherche, Recherche)
		If Recherche > 0
			Caractere = Mid(Texte, Recherche + Longueur, 1)
			Recherche - 1
			If (Caractere < "0" Or Caractere > "9") And (Caractere < "A" Or Caractere > "Z") And (Caractere < "a" Or Caractere > "z")
				If Recherche > 0
					Caractere = Mid(Texte, Recherche, 1)
				EndIf
				If Recherche = 0 Or ((Caractere < "0" Or Caractere > "9") And (Caractere < "A" Or Caractere > "Z") And (Caractere < "a" Or Caractere > "z"))
					Texte = Left(Texte, Recherche) + MotRemplace + Right(Texte, Len(Texte) - Recherche - Longueur)
					Recherche + LongueurRemplace - Longueur
				EndIf
			EndIf
			Recherche + 2
		EndIf
	Until Recherche = 0
	ProcedureReturn Texte
EndProcedure

Procedure.s   dobro_replace(chaine$,chaine_cherche$,chaine_remplace$)
	; by Dobro
	Static extrait1$,pos
	If pos= Len (chaine$)
		text2$=extrait1$
		pos=0 :extrait1$= ""
		ProcedureReturn text2$
	EndIf
	pos=pos+1
	extrait1$=extrait1$+ Mid (chaine$,pos,1)
	car_avant= Asc ( Mid (chaine$,pos-1,1)) ; le caractere avant
	car_apres= Asc ( Mid (chaine$,pos+ Len (chaine_cherche$),1)) ; ) ; le caractere apres
	extrait3$= Mid (chaine$,pos, Len (chaine_cherche$)) ; la chaine extraite
	
	If extrait3$=chaine_cherche$
		If (car_apres<48 Or (car_apres>57 And car_apres<65) Or (car_apres>90 And car_apres<97) Or car_apres>122 )
			If pos>1
				If (car_avant<48 Or (car_avant>57 And car_avant<65) Or (car_avant>90 And car_avant<97) Or car_avant>122 )
					extrait1$= Left (extrait1$, Len (extrait1$)-1)
					extrait1$=extrait1$+chaine_remplace$
					pos=pos+ Len (chaine_cherche$)-1
				EndIf
			Else
				extrait1$= Left (extrait1$, Len (extrait1$)-1)
				extrait1$=extrait1$+chaine_remplace$
				pos=pos+ Len (chaine_cherche$)-1
			EndIf
		EndIf
	EndIf
	text2$=dobro_replace(chaine$,chaine_cherche$,chaine_remplace$)
	ProcedureReturn text2$
EndProcedure
ProcedureDLL.s   dobro_replace2(chaine$,chaine_cherche$,chaine_remplace$)
	; by Dobro
	For pos=1 To Len (chaine$)
		extrait1$=extrait1$+ Mid (chaine$,pos,1)
		car_avant= Asc ( Mid (chaine$,pos-1,1)) ; le caractere avant
		car_apres= Asc ( Mid (chaine$,pos+ Len (chaine_cherche$),1)) ; ) ; le caractere apres
		extrait3$= Mid (chaine$,pos, Len (chaine_cherche$)) ; la chaine extraite
		
		If extrait3$=chaine_cherche$
			If (car_apres<48 Or (car_apres>57 And car_apres<65) Or (car_apres>90 And car_apres<97) Or car_apres>122 )
				If pos>1
					If (car_avant<48 Or (car_avant>57 And car_avant<65) Or (car_avant>90 And car_avant<97) Or car_avant>122 )
						extrait1$= Left (extrait1$, Len (extrait1$)-1)
						extrait1$=extrait1$+chaine_remplace$
						pos=pos+ Len (chaine_cherche$)-1
					EndIf
				Else
					extrait1$= Left (extrait1$, Len (extrait1$)-1)
					extrait1$=extrait1$+chaine_remplace$
					pos=pos+ Len (chaine_cherche$)-1
				EndIf
			EndIf
		EndIf
	Next pos
	
	text2$=extrait1$
	pos=0 :extrait1$= ""
	ProcedureReturn text2$
EndProcedure 

Structure MemoryArray 
	Byte.c[0] 
EndStructure 
Global Dim AllowedChar.c(255)
For i = '0' To '9'
	AllowedChar(i) = 1
Next
For i = 'A' To 'Z'
	AllowedChar(i) = 1
Next
For i = 'a' To 'z'
	AllowedChar(i) = 1
Next
Procedure.s Remplace_Mot_Variante(Texte.s, MotCherche.s, MotRemplace.s) 
	Protected Recherche, LongueurCherche, LongueurRemplace
	Protected *Texte.MemoryArray
	Longueur = Len(MotCherche) 
	LongueurRemplace = Len(MotRemplace) 
	*Texte = @Texte
	Repeat 
		Recherche = FindString(Texte, MotCherche, Recherche) 
		If Recherche
			If AllowedChar(*Texte\Byte[Recherche + Longueur - 1]) = 0
				If Recherche = 1 Or (AllowedChar(*Texte\Byte[Recherche - 2]) = 0) 
					Texte = Left(Texte, Recherche - 1) + MotRemplace + Right(Texte, Len(Texte) - Recherche - Longueur + 1) 
					Recherche + LongueurRemplace - Longueur 
				EndIf 
			EndIf 
			Recherche + 2 
		EndIf 
	Until Recherche = 0 
	ProcedureReturn Texte 
EndProcedure

Texte.s ="Bonjour, je suis le bon bonbon contre les caries de suisse"

Temps = ElapsedMilliseconds()
For n = 1 To 50000
	Texte_LSI.s = Remplace_Mot(Texte, "bon", "tres bon")
	Texte_LSI = Remplace_Mot(Texte_LSI, "suis", "mange")
Next
Temps_LSI = ElapsedMilliseconds() - Temps

Temps = ElapsedMilliseconds()
For n = 1 To 50000
	Texte_Dobro.s = dobro_replace(Texte, "bon", "tres bon")
	Texte_Dobro = dobro_replace(Texte_Dobro, "suis", "mange")
Next
Temps_Dobro = ElapsedMilliseconds() - Temps

Temps = ElapsedMilliseconds()
For n = 1 To 50000
	Texte_Dobro2.s = dobro_replace2(Texte, "bon", "tres bon")
	Texte_Dobro2 = dobro_replace2(Texte_Dobro2, "suis", "mange")
Next
Temps_Dobro2 = ElapsedMilliseconds() - Temps

Temps = ElapsedMilliseconds()
For n = 1 To 50000
	Texte_Gnozal.s = Remplace_Mot_Variante(Texte, "bon", "tres bon")
	Texte_Gnozal = Remplace_Mot_Variante(Texte_Gnozal, "suis", "mange")
Next
Temps_Gnozal = ElapsedMilliseconds() - Temps



MessageRequester("Temps", Texte + Chr(10) + Texte_LSI + Chr(10) + "LSI = " + Str(Temps_LSI) + Chr(10) + Texte_Dobro + Chr(10) + "Dobro récursif = " + Str(Temps_Dobro) + Chr(10) + Texte_Dobro2 + Chr(10) + "Dobro non récursif = " + Str(Temps_Dobro2) + Chr(10) + Texte_Gnozal + Chr(10) + "Gnozal = " + Str(Temps_Gnozal))
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru