piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019
-
27 mai 2015 à 23:28
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019
-
15 sept. 2015 à 20:04
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
program Demo_VoirSauts; {$APPTYPE CONSOLE} //IMPORTANT : il faut aciver {$DEFINE VoirBMSauts} dans BMH2CASM uses sysutils, BMH2CASM in 'BMH2CASM.pas';
var C2 : TreBMH2C; T,M : string; R : integer;
procedure montreK(Const BM: PreBMH2C); Pascal; //affiche la progression de la recherhe var I : integer; begin writeln(BM^.Texte); for I := 1 to Pred(BM^.rpPosAvantSaut) do write(' '); write(M,'+',BM^.rpSautBMH); readln; end;
procedure demo(tableSaut : boolean = false); var Mm : integer; begin C2.MaxCharForceBrute:=4; if not C2.pvVoirBMSauts then begin writeln('activer la directive de compilation {$DEFINE VoirBMSauts}'); writeln('pour cette demonstration'); readln; abort; end; C2.RappeldeBMH:=montreK; C2.mot:=M; C2.texte:=T; writeln('length(mot): ',length(M)); if Fab_Sauts(C2) then Repeat R:=chercheDans(C2); if R <> 0 then begin writeln; writeln('trouve:',R,' depuis:',C2.Depuis,' (',C2.infoArevoir,')'); writeln('NB sauts: ',C2.rpNbSauts,' NB recherches mot: ',C2.rpNbrecherchesMot); Mm:=(C2.volPTexte-C2.volPmot)DIV C2.rpNbSauts; writeln('avance moyenne: ',Mm,' char par saut '); C2.rpNbSauts:=0; C2.rpNbrecherchesMot:=0; writeln; end; Until R = 0; writeln('fin recherche Depuis:',C2.Depuis); readln; if tableSaut then visualise_table_mot(C2); Cloturer(C2); writeln('=============================================================='); writeln; end;
begin // Insérer le code utilisateur ici writeln('appuyer sur la touche <retour>'); writeln; writeln('recherche mot dans texte algo BMH 2 chars'); writeln; M:='OaObOcOO'; T:='------xO-----aO---bO-cO-------bc---'+M+'---'; init_TreBMH2C(C2); demo(true);
writeln('sautMax avec table=65535, test ci dessous avec sautMax=4'); writeln; ctMaxWord:=4; init_TreBMH2C(C2); demo; ctMaxWord:=$FFFF;
writeln('MinusOR20H mis a true'); writeln; M:='OAOBOCOO'; init_TreBMH2C(C2); C2.MinusOR20H:=true; demo(true);
writeln('Minus environ= true: test mot au debut au milieu a la fin'); writeln; M:='OAOB!x!OCOO'; T:='------------------OAOB?x?OCOO---------------OAOB?x?OCOO--'; init_TreBMH2C(C2); TypeRecherche(C2,enMinusSouple); demo;
writeln('trouve mot sensiblement different plus rapidement ou loupe le mot ?'); writeln; writeln('test sans regard des accents en respectant MAJ/min'); M:='éAzèabCç'; T:='-------------------éazeabcc-------------------éAzeabCc---'; init_TreBMH2C(C2); TypeRecherche(C2,enSansAccent); demo;
writeln('sans tenir compte de la difference MAJ/min'); init_TreBMH2C(C2); TypeRecherche(C2,enSansAccentMinus); demo;
writeln('fin'); readln; end.
Salutations
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 5 sept. 2015 à 15:02
@Rekin85
Bonjour,
je vais essayer, il n'est jamais facile de rassembler ces idées de façon simple.
Salutations
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 1 sept. 2015 à 22:46
Bonsoir,
Les baignades sont terminées, hélas.
Salutations.
Rekin85
Messages postés25Date d'inscriptiondimanche 11 décembre 2011StatutMembreDernière intervention17 octobre 2015 24 juil. 2015 à 09:13
Bonjour Piette et félicitations pour ton boulot. (qui justifie mon tuto... Merci)
La function Fab_sauts() contient manifestement un concept novateur pour le Boyer-Moore. Serait-il possible d'avoir une explication simple de la chose ?
>> "J'ai regardé, c'est une autre façon de 'voir les choses'. Une autre approche.Mais plus rapide sans aucun doute, bravo."
A noter en plus que cette autre approche rend l'algo "tolérant certaines fautes de frappe" susceptibles de polluer les Textes dans lesquels on fait une recherche comme par exemple : je cherche "Yellow submarine" et l'un des textes contient "Yallow submarine" et l'autre "Yellow submarime"
Dans un tel cas l'algo trouve l'occurrence alors qu'un algo "strict" tel que PosEx ne la trouve pas.
>> "Je vais rester sur une approche binaire, ce sera intéressant de voir de combien la différence entre ces 2 approches se réduit en ms avec l'ASM?" :
Ce serait effectivement intéressant.
>> "Il est aussi possible de 'fouiller' avec votre méthode et ensuite de confirmer octets après octets la validité absolue de la 'trouvaille', ce qui marierai les 2 approches! " :
Bin comme ma méthode est tolérante à un certain nombre de fautes de frappe cela supposerait qu'il soit possible de confirmer par une logique :
- soit que les occurrences trouvées contiennent de simples fautes de frappe,
- soit qu'il s'agit d'occurrences parasites.
>> "je retourne sur la plage." :
Bonne baignade...
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 16 juil. 2015 à 19:56
Bonjour,
J'ai regardé, c'est une autre façon de 'voir les choses'.
Une autre approche.
Mais plus rapide sans aucun doute, bravo.
Je vais rester sur une approche binaire, ce sera intéressant de voir de combien la différence entre ces 2 approches se réduit en ms avec l'ASM?
Il est aussi possible de 'fouiller' avec votre méthode et ensuite de confirmer octets après octets la validité absolue de la 'trouvaille', ce qui marierai les 2 approches!
je retourne sur la plage.
Voir le message d'Aujourd'hui 13/07/2015 à 11h09 (message n°#35) qui commence par "Le projet de Brute force de Rekin85 m'a donné une idée d'un Boyer-Moore "brutal" qui utilise un coulisseau à 5 Trous"
Je pense que l'amélioration est susceptible de vous intéresser.
Réponse au message de Piette du 12 juil. 2015 à 23:16
>> "voici une modif pour palier au problème d'initialisation du record: ": OK, merci beaucoup.
Et voici les résultats de mes tests comparatifs de vitesse qui incluent une nouvelle routine de mon cru (BMHPascalC5T) basée sur une astuce qui augmente la vitesse d'exécution :
A) Pour 100 000 Recherches de Mot de 175 caractères aléatoires dans Texte de 97 345 caractères aléatoires et Mot présent 16 fois dans chaque texte
- Avec StrUtils.PosEx ASM version => Trouvé : 1 600 000 fois, Mis : 1 919 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 1 600 000 fois, Mis : 499 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 453 ms
- Avec BMHPascalNaifEx => Trouvé : 1 600 000 fois, Mis : 421 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 327 ms
- Avec ChercheDans => Trouvé : 1 600 000 fois, Mis : 2 465 ms - Avec BMHPascalC5T => Trouvé : 1 600 000 fois, Mis : 297 ms
B) Pour 1 000 000 Recherches de Mot de 1 000 caractères aléatoires dans Texte de 20 200 caractères aléatoires et Mot présent 10 fois dans chaque texte - Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 4 353 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 7 020 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 5 413 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 5 444 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 560 ms
- Avec ChercheDans => Trouvé : 10 000 000 fois, Mis : 7 878 ms - Avec BMHPascalC5T => Trouvé : 10 000 000 fois, Mis : 140 ms
C) Pour 10 000 Recherches de Phrase de 554 caractères dans Texte de ZOLA de 1 048 838 caractères aléatoires et Phrase présente 1 fois en fin de texte - Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 059 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 780 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 718 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 982 ms
- Avec ChercheDans => Trouvé : 10 000 fois, Mis : 3 448 ms - Avec BMHPascalC5T => Trouvé : 10 000 fois, Mis : 764 ms
D) Pour 10 000 Recherches de Mot de 9 caractères 'Catherine' dans Texte de ZOLA de 1 048 838 caractères aléatoires et Mot présent ? fois dans chaque texte - Avec StrUtils.PosEx ASM version => Trouvé : 2 390 000 fois, Mis : 12 137 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 2 390 000 fois, Mis : 6 583 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 2 390 000 fois, Mis : 5 881 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 2 390 000 fois, Mis : 12 137 ms
- Avec ChercheDans => Trouvé : 2 390 000 fois, Mis : 13 541 ms - Avec BMHPascalC5T => Trouvé : 2 390 000 fois, Mis : 5 975 ms
E) Pour 10 000 Recherches de Mot de 12 caractères 'MOTFINALZOLA' dans Texte de ZOLA de 1 048 838 caractères aléatoires et Mot présent 1 fois en fin de texte - Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 059 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 2 948 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 2 730 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 10 000 fois, Mis : 2 044 ms
- Avec ChercheDans => Trouvé : 10 000 fois, Mis : 3 089 ms - Avec BMHPascalC5T => Trouvé : 10 000 fois, Mis : 2 948 ms
F) Pour 10 000 Recherches de Mot de 22 caractères 'Un débordement de sève' dans Texte de ZOLA de 1 048 838 caractères aléatoires et Mot présent ? fois dans chaque texte - Avec StrUtils.PosEx ASM version => Trouvé : 20 000 fois, Mis : 12 496 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 20 000 fois, Mis : 3 479 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 20 000 fois, Mis : 3 198 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 20 000 fois, Mis : 12 527 ms
- Avec ChercheDans => Trouvé : 20 000 fois, Mis : 14 399 ms - Avec BMHPascalC5T => Trouvé : 20 000 fois, Mis : 3 245 ms
Pour en savoir plus sur l'astuce à la base de la vitesse d'exécution de BMHPascalC5T j'en ai publié le principe et le code dans ce Forum (Oups j'ai oublié l'url) car ici les codes qu'on publie dans les commentaires disparaissent très vite.
Bon je récupère l'url de la discussion du Forum et je reviens.
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 12 juil. 2015 à 23:16
Bonjour,ciel couvert.
Il semble que l'application console initialise var v2c : TreBMH2C; et pas l'application?
Je regarde :
le prog pour la possibilité de scruter des fichiers de 2^63-1 octets de long.
un prog pour définir la frontière entre BMH2C et force brut en fx des caractéristique du texte, ce qui revient à définir ctposDJ
ensuite je traduirai le tout en asm.
bon été
voici une modif pour palier au problème d'initialisation du record:
//recherche type BMH avec 2 caractéres 1° char=colonne 2° char=ligne //normalisation de la table Tar2chars ligne=2^n {$DEFINE _voirTable}
interface
uses SysUtils;
Const ctNchar = 255; ctposDJ = 16; //test posDJ si mot < ctposDJ ctFichierTable = '$BMH2chars$.txt'; type TarNchars = array[0..ctNchar] of Byte; Tar2chars = array[0..ctNchar*ctNchar] of Word; TPar2chars = ^Tar2chars; TreBMH2C= Packed Record //ne pas déplacer, ne pas utiliser arNchars : TarNchars; Par2chars : TPar2chars; Lmot,NbLignes : Word; Volar2chars : integer; // en octets NcharDiff : Word; //Nb char différents ForceBrut : boolean; //utilisateur mot,texte : AnsiString; Depuis,jusqua : Integer; end; procedure init_TreBMH2C(var BM : TreBMH2C); procedure visualise_table(var BM : TreBMH2C); function Fab_Sauts(var BM : TreBMH2C): boolean; //Mot = 2 char mini function chercheDans(var BM : TreBMH2C) : integer; procedure cloturer(var BM : TreBMH2C);
function BIcompareSTR(Const S1,S2: AnsiString; OffsetS2: integer): boolean; Register; {recherche Binaire S1= 2 chars mini ATTENTION pas de contrôle des données pour accepter 1 char mini supprimer parties entre SUP} ASM //eax=ptr(S1) edx=ptr(S2) ecx=OffsetS2 ADD EDX,ECX //----------SUP-------------- MOV CX,WORD ptr[EDX] CMP CX,WORD ptr[EAX] JNZ @distagan //-----------SUP------------ PUSH ESI PUSH EDI MOV ESI,EAX //ESI = ptr(S1) MOV EDI,EDX MOV ECX,[ESI-4] // ECX = len(S1) //-----------SUP------------- ADD ESI,2 ADD EDI,2 SUB ECX,2 //-----------SUP------------- MOV EDX,ECX SHR ECX,2 //lenS1 DIV 4 AND ECX,ECX JZ @Dilost4 @Rodell4: //test par 4 octets MOV EAX,DWORD ptr[EDI] CMP EAX,DWORD ptr[ESI] JNZ @Nann ADD ESI,4 ADD EDI,4 DEC ECX JNZ @Rodell4 @Dilost4: AND EDX,$00000003 // EDX modulo 4 -> 0..3 JZ @Ya @Rodell1: //test par 1 octet MOV AL,BYTE ptr[EDI] CMP AL,BYTE PTR[ESI] JNZ @Nann INC ESI INC EDI DEC EDX JNZ @Rodell1 @Ya: XOR EAX,EAX INC EAX POP EDI POP ESI RET @Nann: POP EDI POP ESI @Distagan: XOR EAX,EAX RET end;
procedure fillWord(var X; Count: Integer; Value: Word); Register; asm PUSH EDI MOV EDI,EAX //var X MOV AX,CX //Value MOV ECX,EDX //Count CLD REP STOSW POP EDI end;
procedure init_TreBMH2C(var BM : TreBMH2C); begin fillchar(BM,sizeof(TreBMH2C),0); end;
function Fab_Sauts(var BM : TreBMH2C): boolean; var I : integer; begin Result:=length(BM.mot) > 1; if not Result then exit; BM.jusqua:=0; BM.Depuis:=1; BM.Lmot:=length(BM.mot); BM.ForceBrut:=BM.Lmot < ctposDJ; if BM.ForceBrut then exit;
fillchar(BM.arNchars,sizeof(BM.arNchars),0); //comptage Nb lettres <> for I := 1 to BM.Lmot do BM.arNchars[ord(BM.mot[I])]:=1; BM.NcharDiff:=1; for I := 0 to Pred(ord(BM.mot[1])) do if BM.arNchars[I] <> 0 then begin inc(BM.NcharDiff); BM.arNchars[I]:=BM.NcharDiff; end; for I := Succ(ord(BM.mot[1])) to ctNchar do if BM.arNchars[I] <> 0 then begin inc(BM.NcharDiff); BM.arNchars[I]:=BM.NcharDiff; end; BM.NbLignes:=Succ(BM.NcharDiff); if BM.Par2chars <> NIL then FreeMem(BM.Par2chars,BM.Volar2chars); BM.Volar2chars:=(BM.NbLignes*BM.NbLignes*sizeof(Word)); GetMem(BM.Par2chars,BM.Volar2chars); fillWord(BM.Par2chars^,BM.NbLignes*BM.NbLignes,BM.Lmot); fillWord(BM.Par2chars^,BM.NbLignes*2,Pred(BM.Lmot)); fillWord(BM.Par2chars^,BM.NbLignes,BM.Lmot); //remplissage de la table for I := 1 to BM.Lmot-2 do BM.Par2chars^[BM.arNchars[ord(BM.mot[I])]+ BM.arNchars[ord(BM.mot[Succ(I)])]* BM.NbLignes]:=Pred(BM.Lmot)-I; end;
function chercheDans(var BM : TreBMH2C): integer; var LT,K : Cardinal;
begin Result:=0; LT:=length(BM.texte); if BM.Depuis < 1 then BM.Depuis:=1; if (BM.Jusqua > BM.Depuis) and (BM.jusqua < LT) then LT:=BM.jusqua; if BM.ForceBrut then begin Result:=PosDJ(BM.mot,BM.texte,BM.Depuis,BM.jusqua); exit; end; K:=Pred(BM.Depuis); LT:=Succ(LT-BM.Lmot); while K < LT do begin if BIcompareSTR(BM.mot,BM.texte,K) then begin Result:=Succ(K); BM.Depuis:=Result+BM.Lmot; exit; end; //trouve inc(K,BM.Par2chars^[BM.arNchars[ord(BM.texte[Pred(BM.Lmot)+K])]+ BM.arNchars[ord(BM.texte[BM.Lmot+K])]* BM.NbLignes]); end; end;
procedure cloturer(var BM : TreBMH2C); //vide BM begin if BM.Par2chars <> NIL then FreeMem(BM.Par2chars,BM.Volar2chars); BM.Par2chars:=NIL; BM.mot:=''; BM.texte:=''; end;
procedure visualise_table(var BM : TreBMH2C);
var TSL : TstringList; I,J : integer; S,T : string;
procedure visualiser_le_fichier(Const FileName: string); begin ShellExecute(0,'open',Pchar(FileName),nil,nil,sw_normal); end;
function A2(W:Word): string; begin Result:=intToSTR(W); if length(Result) = 1 then Result:='0'+Result; end; begin TSL:=TstringList.Create; TSL.Add('FICHIER A 2 ENTREES'); TSL.Add('Masque = char1 dans colonne char2 dans ligne 0=inconnus'); TSL.Add('table [0..'+intToSTR(Pred(BM.NbLignes))+',0..'+ intToSTR(Pred(BM.NbLignes))+'] of Word'); TSL.Add('Mot:['+BM.mot+'] longueur = '+intToSTR(length(BM.mot))+' chars et '+ intToStr(BM.NcharDiff)+' chars différents'); SetLength(S,BM.NcharDiff); for I := 0 to ctNchar do if BM.arNchars[I] <> 0 then S[BM.arNchars[I]]:=chr(I); T:=' 0 '; for I := 1 to BM.NcharDiff do T:=T+S[I]+' '; TSL.Add(T);
//scrute table T:=''; for I := 0 to Pred(BM.NbLignes) do Begin if I <= BM.NcharDiff then begin if I = 0 then T:=T+'0 ' else T:=T+S[I]+' '; end else T:=T+' '; for J := 0 to Pred(BM.NbLignes) do T:=T+A2(BM.Par2chars^[I * BM.NbLignes+J])+' '; TSL.Add(T); T:=''; end; TSL.SaveToFile(ctFichierTable); TSL.free; visualiser_le_fichier(ctFichierTable); end;
J'ai enfin trouvé la cause de la Violation d'accès : c'est l'instruction if BM.Par2chars <> nil then FreeMem(BM.Par2chars, BM.Volar2chars) qui la causait :
function Fab_Sauts(var BM: TreBMH2C): boolean; var I: integer; begin ShowMessage('Fab_Sauts Deb'); Result := length(BM.mot) > 1; if not Result then exit; BM.jusqua := 0; BM.Depuis := 1; BM.Lmot := length(BM.mot); BM.ForceBrut := BM.Lmot < ctposDJ; if BM.ForceBrut then begin showmessage('exit Fab_Sauts'); exit; end;
fillchar(BM.arNchars, succ(ctNchar), 0); //comptage Nb lettres <> for I := 1 to BM.Lmot do BM.arNchars[ord(BM.mot[I])] := 1; BM.NcharDiff := 1; ShowMessage('Fab_Sauts 1'); for I := 0 to Pred(ord(BM.mot[1])) do if BM.arNchars[I] <> 0 then begin inc(BM.NcharDiff); BM.arNchars[I] := BM.NcharDiff; end; ShowMessage('Fab_Sauts 2'); for I := Succ(ord(BM.mot[1])) to ctNchar do if BM.arNchars[I] <> 0 then begin inc(BM.NcharDiff); BM.arNchars[I] := BM.NcharDiff; end; ShowMessage('Fab_Sauts 3'); //normalisation 2^n BM.NbLignes := Succ(BM.NcharDiff); //if BM.Par2chars <> nil then FreeMem(BM.Par2chars, BM.Volar2chars); < ici la cause de la V.A. BM.Volar2chars := (BM.NbLignes * BM.NbLignes * sizeof(Word)); GetMem(BM.Par2chars, BM.Volar2chars); ShowMessage('Fab_Sauts 4'); fillWord(BM.Par2chars^, BM.NbLignes * BM.NbLignes, BM.Lmot); fillWord(BM.Par2chars^, BM.NbLignes * 2, Pred(BM.Lmot)); fillWord(BM.Par2chars^, BM.NbLignes, BM.Lmot); ShowMessage('Fab_Sauts 5'); //remplissage de la table for I := 1 to BM.Lmot - 2 do BM.Par2chars^[BM.arNchars[ord(BM.mot[I])] + BM.arNchars[ord(BM.mot[Succ(I)])] * BM.NbLignes] := Pred(BM.Lmot) - I; ShowMessage('Fab_Sauts Fin'); end;
Résultats du test :
TEXTE : -Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!-Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!-Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!-Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!
len V2C.texte : 380
MOT : Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!
Réponse au message de Piette du 9 juil. 2015 à 22:20
Quand j'utilise votre code de test comme ci-dessous j'ai une Violation d'Accès qui se produit dans l'instruction située entre le ShowMessage('ici 1') et le ShowMessage('ici 2') :
procedure TForm1.bPiette9juilletClick(Sender: TObject); var v2c: TreBMH2C; I, N, R, J: integer; SubMaj: string; G: longInt;
begin J := 500000; V2C.mot := 'Bonjour de Bretagne ou il fait beau'; V2C.mot := V2C.mot + ' et re' + V2C.mot + ', bonnes vacances!'; V2C.texte := '-' + V2C.mot + '-' + V2C.mot + '-' + V2C.mot + '-' + V2C.mot; Trace(V2C.texte); Trace('');
N := 0; G := GetTickCount; for I := 1 to j do begin V2C.Depuis := 1; repeat R := chercheDans(V2C); if R <> 0 then begin //write(' pos:',R,'D',D); inc(N); end; until R = 0; end; end; Trace(''); G := GetTickCount - G; Trace(intToStr(N)+ ' trouvailles en ---------------'+ intToStr(G)+ ' ms'); Trace(''); .... end;
Ce que je ne pige pas c'est pourquoi j'ai cette V.A ???
>> "il y a 2 voies suivant la longueur du mot : force brut Dword : Boyer Moore 2 caractères" :
Oui j'ai remarqué car si Length(Mot) < ctposDJ = 16 alors c'est la PosEX modifiée avec Depuis et Jusqua qui fait le boulot.
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 9 juil. 2015 à 22:20
Belle journée ensoleillée,
J'avais déjà livré _posDJ , mais pas facile a retrouver dans ces 102!
voici dessous :
unit _posDJ;
interface
function PosDJ(const SubStr, S: string; var Depuis: Integer; jusqua : integer = 0): Integer; Register;
implementation
function PosDJ(const SubStr, S: string; var Depuis: Integer; jusqua : integer = 0): Integer; Register; asm //modification de PosEX [ebp+8]=jusqua Recherche binaire push ebx cmp eax, 1 sbb ebx, ebx {-1 if SubStr = '' else 0} sub edx, 1 {-1 if S = ''} sbb ebx, 0 {Negative if S = '' or SubStr = '' else 0} PUSH ECX {ptr Depuis} MOV ECX,[ECX] dec ecx {Offset - 1} or ebx, ecx {Negative if S = '' or SubStr = '' or Offset < 1} jl @@InvalidInput push edi push esi push ebp push edx mov edi, [eax-4] {Length(SubStr)} PUSH EDI mov esi, [edx-3] {Length(S)} PUSH EAX //traitement de jusqua MOV EAX,[EBP+8] //jusqua AND EAX,EAX //test 0 JZ @@x CMP EAX,ESI //Depuis,len(S) JA @@x //EAX > ESI MOV ESI,EAX //jusqua remplace len(S) @@x: MOV [EBP+8],ESI //sauve len(S) active POP EAX add ecx, edi cmp ecx, esi jg @@NotFound {Offset to High for a Match} test edi, edi jz @@NotFound {Length(SubStr = 0)} lea ebp, [eax+edi] {Last Character Position in SubStr + 1} add esi, edx {Last Character Position in S} // movzx eax, [ebp-1] {Last Character of SubStr ne compile pas en D5} MOV AL,[EBP-1] {remplace movzx} AND EAX,$000000FF {remplace movzx} add edx, ecx {Search Start Position in S for Last Character} mov ah, al neg edi {-Length(SubStr)} mov ecx, eax shl eax, 16 or ecx, eax {All 4 Bytes = Last Character of SubStr} @@MainLoop: add edx, 4 cmp edx, esi ja @@Remainder {1 to 4 Positions Remaining} mov eax, [edx-4] {Check Next 4 Bytes of S} xor eax, ecx {Zero Byte at each Matching Position} lea ebx, [eax-$01010101] not eax and eax, ebx and eax, $80808080 {Set Byte to $80 at each Match Position else $00} jz @@MainLoop {Loop Until any Match on Last Character Found} bsf eax, eax {Find First Match Bit} shr eax, 3 {Byte Offset of First Match (0..3)} lea edx, [eax+edx-4] {Address of First Match on Last Character} @@Compare: inc edx cmp edi, -4 jle @@Large {Lenght(SubStr) >= 4} cmp edi, -1 je @@SetResult {Exit with Match if Lenght(SubStr) = 1} mov ax, [ebp+edi] {Last Char Matches - Compare First 2 Chars} cmp ax, [edx+edi] jne @@MainLoop {No Match on First 2 Characters} @@SetResult: {Full Match} lea eax, [edx+edi] {Calculate and Return Result} POP EDI {len SubSTR} pop edx SUB eax, edx {Subtract Start Position} ADD EDI,EAX {prochain depuis} MOV EDX,EDI pop ebp pop esi pop edi POP ECX MOV [ECX],EDX {vers depuis} pop ebx JMP @@end @@NotFound: POP EDI pop edx {Dump Start Position} pop ebp pop esi pop edi MOV EAX,[EBP+8] INC EAX POP ECX MOV [ECX],EAX //len(S)+1 active dans depuis JMP @@xx @@InvalidInput: POP ECX @@xx: pop ebx xor eax, eax {No Match Found - Return 0} JMP @@end @@Remainder: {Check Last 1 to 4 Characters} sub edx, 4 @@RemainderLoop: cmp cl, [edx] je @@Compare cmp edx, esi jae @@NotFound inc edx jmp @@RemainderLoop @@Large: mov eax, [ebp-4] {Compare Last 4 Characters} cmp eax, [edx-4] jne @@MainLoop {No Match on Last 4 Characters} mov ebx, edi @@CompareLoop: {Compare Remaining Characters} add ebx, 4 {Compare 4 Characters per Loop} jge @@SetResult {All Characters Matched} mov eax, [ebp+ebx-4] cmp eax, [edx+ebx-4] je @@CompareLoop {Match on Next 4 Characters} jmp @@MainLoop {No Match} @@END: end; {PosDJ}
end.
ensuite mon testeur console :
program test_2charsUN; {$APPTYPE CONSOLE} uses sysutils, windows, BMH2C in 'BMH2C.pas', _posDJ in '_posDJ.pas';
var v2c : TreBMH2C; I,N,R,J: integer; SubMaj : string; G:longInt;
Function MyGetTickCount: Int64; Var lpPerformanceCount, lpFrequency : Int64; Begin If Not QueryPerformanceCounter(lpPerformanceCount) Then lpPerformanceCount := GetTickCount Else Begin QueryPerformanceFrequency(lpFrequency); lpPerformanceCount := (lpPerformanceCount * 1000) Div lpFrequency End;
result := lpPerformanceCount; End; begin // Insérer le code utilisateur ici J:=500000; V2C.mot:='Bonjour de Bretagne ou il fait beau'; V2C.mot:=V2C.mot+' et re'+V2C.mot+', bonnes vacances!'; V2C.texte:='-'+V2C.mot+'-'+V2C.mot+'-'+V2C.mot+'-'+V2C.mot; writeln(V2C.texte); writeln;
writeln(V2C.mot); if Fab_sauts(V2C) then begin // visualise_table(V2C); writeln('len V2C.texte : ',length(V2C.texte)); N:=0; G:=MyGetTickCount; for I := 1 to j do begin V2C.Depuis:=1; Repeat R:=chercheDans(V2C); if R <> 0 then begin //write(' pos:',R,'D',D); inc(N); end; Until R = 0; end; end; writeln; G:=MyGetTickCount-G; writeln(N,' trouvailles en ---------------',G,' ms'); writeln;
V2C.mot:=copy(V2C.mot,1,3); writeln(V2C.mot); if Fab_sauts(V2C) then begin writeln('len V2C.texte : ',length(V2C.texte)); N:=0; G:=MyGetTickCount; for I := 1 to j do begin V2C.Depuis:=1; Repeat R:=chercheDans(V2C); if R <> 0 then begin //write(' pos:',R,'D',D); inc(N); end; Until R = 0; end; end; writeln; G:=MyGetTickCount-G; writeln(N,' trouvailles en ---------------',G,' ms'); cloturer(V2C); writeln; readln; end.
il y a 2 voies suivant la longueur du mot
force brut Dword
Boyer Moore 2 caractères
avec votre pratique de l'aléatoire à zola vous pourrez affiner la constante :
ctposDJ = 16; //test posDJ si mot < ctposDJ
Pour passer d'un traitement à l'autre, le test joint montre une réduction très importante pour le traitement des mots courts de 939 ms (un type de traitement) à 179 ms (2 types de traitement) pour un mot de 3 chars
>> "j'ai un bout de prog pour tester." :
Voici un premier résultat du test : [Erreur fatale] BMH2C_Piette.pas(36): Fichier non trouvé : '_posDJ.dcu'
Il est où le code de _posDJ ???
>> "En faisant varier ctposDJ il est possible(?) de trouver la frontière entre les 2 types de traitements." :
C'est quoi ces 2 types de traitements ???
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 7 juil. 2015 à 23:04
Bonsoir de Bretagne,
102!
j'ai un bout de prog pour tester.
En faisant varier ctposDJ il est possible(?) de trouver la frontière entre les 2 types de traitements.
unit BMH2C; //recherche type BMH avec 2 caractéres 1° char=colonne 2° char=ligne //normalisation de la table Tar2chars ligne=2^n {$DEFINE _voirTable}
interface
uses SysUtils;
Const ctNchar = 255; ctposDJ = 16; //test posDJ si mot < ctposDJ ctFichierTable = '$BMH2chars$.txt'; type TarNchars = array[0..ctNchar] of Byte; Tar2chars = array[0..ctNchar*ctNchar] of Word; TPar2chars = ^Tar2chars; TreBMH2C= Packed Record //ne pas déplacer, ne pas utiliser arNchars : TarNchars; Par2chars : TPar2chars; Lmot,NbLignes : Word; Volar2chars : integer; // en octets NcharDiff : Word; //Nb char différents ForceBrut : boolean; //utilisateur mot,texte : AnsiString; Depuis,jusqua : Integer; end;
procedure visualise_table(var BM : TreBMH2C); function Fab_Sauts(var BM : TreBMH2C): boolean; //Mot = 2 char mini function chercheDans(var BM : TreBMH2C) : integer; procedure cloturer(var BM : TreBMH2C);
function BIcompareSTR(Const S1,S2: AnsiString; OffsetS2: integer): boolean; Register; {recherche Binaire S1= 2 chars mini ATTENTION pas de contrôle des données pour accepter 1 char mini supprimer parties entre SUP} ASM //eax=ptr(S1) edx=ptr(S2) ecx=OffsetS2 ADD EDX,ECX //----------SUP-------------- MOV CX,WORD ptr[EDX] CMP CX,WORD ptr[EAX] JNZ @distagan //-----------SUP------------ PUSH ESI PUSH EDI MOV ESI,EAX //ESI = ptr(S1) MOV EDI,EDX MOV ECX,[ESI-4] // ECX = len(S1) //-----------SUP------------- ADD ESI,2 ADD EDI,2 SUB ECX,2 //-----------SUP------------- MOV EDX,ECX SHR ECX,2 //lenS1 DIV 4 AND ECX,ECX JZ @Dilost4 @Rodell4: //test par 4 octets MOV EAX,DWORD ptr[EDI] CMP EAX,DWORD ptr[ESI] JNZ @Nann ADD ESI,4 ADD EDI,4 DEC ECX JNZ @Rodell4 @Dilost4: AND EDX,$00000003 // EDX modulo 4 -> 0..3 JZ @Ya @Rodell1: //test par 1 octet MOV AL,BYTE ptr[EDI] CMP AL,BYTE PTR[ESI] JNZ @Nann INC ESI INC EDI DEC EDX JNZ @Rodell1 @Ya: XOR EAX,EAX INC EAX POP EDI POP ESI RET @Nann: POP EDI POP ESI @Distagan: XOR EAX,EAX RET end;
procedure fillWord(var X; Count: Integer; Value: Word); Register; asm PUSH EDI MOV EDI,EAX //var X MOV AX,CX //Value MOV ECX,EDX //Count CLD REP STOSW POP EDI end;
function Fab_Sauts(var BM : TreBMH2C): boolean; var I : integer; begin Result:=length(BM.mot) > 1; if not Result then exit; BM.jusqua:=0; BM.Depuis:=1; BM.Lmot:=length(BM.mot); BM.ForceBrut:=BM.Lmot < ctposDJ; if BM.ForceBrut then exit;
fillchar(BM.arNchars,succ(ctNchar),0); //comptage Nb lettres <> for I := 1 to BM.Lmot do BM.arNchars[ord(BM.mot[I])]:=1; BM.NcharDiff:=1; for I := 0 to Pred(ord(BM.mot[1])) do if BM.arNchars[I] <> 0 then begin inc(BM.NcharDiff); BM.arNchars[I]:=BM.NcharDiff; end; for I := Succ(ord(BM.mot[1])) to ctNchar do if BM.arNchars[I] <> 0 then begin inc(BM.NcharDiff); BM.arNchars[I]:=BM.NcharDiff; end; //normalisation 2^n BM.NbLignes:=Succ(BM.NcharDiff); if BM.Par2chars <> NIL then FreeMem(BM.Par2chars,BM.Volar2chars); BM.Volar2chars:=(BM.NbLignes*BM.NbLignes*sizeof(Word)); GetMem(BM.Par2chars,BM.Volar2chars); fillWord(BM.Par2chars^,BM.NbLignes*BM.NbLignes,BM.Lmot); fillWord(BM.Par2chars^,BM.NbLignes*2,Pred(BM.Lmot)); fillWord(BM.Par2chars^,BM.NbLignes,BM.Lmot); //remplissage de la table for I := 1 to BM.Lmot-2 do BM.Par2chars^[BM.arNchars[ord(BM.mot[I])]+ BM.arNchars[ord(BM.mot[Succ(I)])]* BM.NbLignes]:=Pred(BM.Lmot)-I; end;
function chercheDans(var BM : TreBMH2C): integer; var LT,K : Cardinal;
begin Result:=0; LT:=length(BM.texte); if BM.Depuis < 1 then BM.Depuis:=1; if (BM.Jusqua > BM.Depuis) and (BM.jusqua < LT) then LT:=BM.jusqua; if BM.ForceBrut then begin Result:=PosDJ(BM.mot,BM.texte,BM.Depuis,BM.jusqua); exit; end; K:=Pred(BM.Depuis); while (BM.Lmot+K)<= LT do begin if BIcompareSTR(BM.mot,BM.texte,K) then begin Result:=Succ(K); BM.Depuis:=Result+BM.Lmot; exit; end; //trouve K:=K+BM.Par2chars^[BM.arNchars[ord(BM.texte[Pred(BM.Lmot)+K])]+ BM.arNchars[ord(BM.texte[BM.Lmot+K])]* BM.NbLignes]; end; end;
procedure cloturer(var BM : TreBMH2C); //vide BM begin if BM.Par2chars <> NIL then FreeMem(BM.Par2chars,BM.Volar2chars); BM.Par2chars:=NIL; BM.mot:=''; BM.texte:=''; end;
procedure visualise_table(var BM : TreBMH2C);
var TSL : TstringList; I,J : integer; S,T : string;
procedure visualiser_le_fichier(Const FileName: string); begin ShellExecute(0,'open',Pchar(FileName),nil,nil,sw_normal); end;
function A2(W:Word): string; begin Result:=intToSTR(W); if length(Result) = 1 then Result:='0'+Result; end; begin TSL:=TstringList.Create; TSL.Add('FICHIER A 2 ENTREES'); TSL.Add('Masque = char1 dans colonne char2 dans ligne 0=inconnus'); TSL.Add('table [0..'+intToSTR(Pred(BM.NbLignes))+',0..'+ intToSTR(Pred(BM.NbLignes))+'] of Word'); TSL.Add('Mot:['+BM.mot+'] longueur = '+intToSTR(length(BM.mot))+' chars et '+ intToStr(BM.NcharDiff)+' chars différents'); SetLength(S,BM.NcharDiff); for I := 0 to ctNchar do if BM.arNchars[I] <> 0 then S[BM.arNchars[I]]:=chr(I); T:=' 0 '; for I := 1 to BM.NcharDiff do T:=T+S[I]+' '; TSL.Add(T);
//scrute table T:=''; for I := 0 to Pred(BM.NbLignes) do Begin if I <= BM.NcharDiff then begin if I = 0 then T:=T+'0 ' else T:=T+S[I]+' '; end else T:=T+' '; for J := 0 to Pred(BM.NbLignes) do T:=T+A2(BM.Par2chars^[I * BM.NbLignes+J])+' '; TSL.Add(T); T:=''; end; TSL.SaveToFile(ctFichierTable); TSL.free; visualiser_le_fichier(ctFichierTable); end;
end.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 3 juil. 2015 à 16:14
re,
j'ai eu l'idée d'une implémentation du Boyer-Moore pour recherche d'occurences de plus de 256 bytes.
mais cette limite n'existe pas !!!
Et c'est pas parce que les fonctions demandes des strings en entrée qu'on ne peut pas rechercher du binaire avec !!!
pour vous un petit exemple avec une recherche d'image (de 144 507 Octets) dans un fichier binaire (exécutable)
@+ Cirec
Rekin85
Messages postés25Date d'inscriptiondimanche 11 décembre 2011StatutMembreDernière intervention17 octobre 2015 1 juil. 2015 à 22:13
Rekin85
Messages postés25Date d'inscriptiondimanche 11 décembre 2011StatutMembreDernière intervention17 octobre 2015 1 juil. 2015 à 18:54
Et cela pourrait continuer encore, car depuis que je regarde cette discussion évoluer au gré des améliorations et tests successifs, depuis le début, j'ai eu l'idée d'une implémentation du Boyer-Moore pour recherche d'occurences de plus de 256 bytes. J'ai donc selon ma nouvelle habitude de travail développé une dll pour tout langage de haut niveau sous windows en 32 bits.
Mais avant d'en dévoiler le code, j'aurais besoin de savoir si elle tient le coup dans vos tests actuels et où elle se situe par rapport à vos performances. Malheureusement, il n'est pas possible d'adjoindre des fichiers aux topics d'ici... En plus ce lieu n'est pas propice, à mon avis aux échanges bien plus ouverts aux programmeurs.
Alors, si vous êtes d'accord, j'ai comme solution :
Soit d'ouvrir ici une nouvelle offre de code source
Soit de passer sur un autre site dédié à Delphi où le challenge proposé sera plus ouvert...
Qu'en dites-vous ?
Avec mes salutations.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 1 juil. 2015 à 15:52
Le centième message
Depuis que DelphiFr est passé CS_CCM c'est la première fois qu'une discussion suscite autant de réponses ... Youpi pourvu que ça dure
il fallait bien marquer le coup !!!
@+Cirec
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 30 juin 2015 à 18:13
Résultats des tests avec utilisation de la nouvelle BIcompareSTR de Piette du 30 juin 2015 à 15:30
Pour le bon comptage des occurrences c'est OK.
Pour les tests de vitesse, les voici :
A) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 370 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 370 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 385 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 4 165 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 855 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 3 354 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 357 ms
- Avec V2C.chercheDans avec BIcompareSTR => Trouvé : 10 000 000 fois, Mis : 983 ms
B) Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de Zola de 1 048 842 caractères et Mot présent à la fin du texte
Compilé avec array[Byte] of Integer
:
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 028 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 752 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 112 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 127 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec V2C.chercheDans avec BIcompareSTR => Trouvé : 10 000 fois, Mis : 21 793 ms
Dommage que ce ne soit pas toujours la même routine à être la plus rapide.
>> "J'ai regardé CompareSTR, il parait difficile de faire plus vite.
par contre la double table de saut est efficace à partir d'une vingtaine
d'octets"
Dommage qu'elle ne soit pas efficace dans tous les cas.
Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de ZOLA de 1 048 842 caractères et Mot présent 1 fois à la fin du Texte
Compilé avec array[Byte] of Integer :
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 200 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 767 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 112 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 144 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 996 ms
- Avec V2C.chercheDans et BIcompareSTR => Trouvé : 2 622 100 000 fois, Mis : 19 422 ms<< ??? Bizarre
- Avec BMH_CompareSTR => Trouvé : 10 000 fois, Mis : 8 237 ms
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 30 juin 2015 à 09:33
Bonjour,
Essayez cela:
function BIcompareSTR(Const S1,S2: AnsiString; OffsetS2: integer): boolean; Register; {recherche Binaire S1= 2 chars mini ATTENTION pas de contrôle des données pour accepter 1 char mini supprimer parties entre SUP} ASM //eax=ptr(S1) edx=ptr(S2) ecx=OffsetS2 ADD EDX,ECX //----------SUP-------------- MOV CX,WORD ptr[EDX] CMP CX,WORD ptr[EAX] JNZ @distagan //-----------SUP------------ PUSH ESI PUSH EDI MOV ESI,EAX //ESI = ptr(S1) MOV EDI,EDX MOV ECX,[ESI-4] // ECX = len(S1) //-----------SUP------------- SUB ESI,2 SUB EDI,2 SUB ECX,2 //-----------SUP------------- MOV EDX,ECX SHR ECX,2 //lenS1 DIV 4 AND ECX,ECX JZ @Dilost4 @Rodell4: //test par 4 octets MOV EAX,DWORD ptr[EDI] CMP EAX,DWORD ptr[ESI] JNZ @Nann ADD ESI,4 ADD EDI,4 DEC ECX JNZ @Rodell4 @Dilost4: AND EDX,$00000003 // EDX modulo 4 -> 0..3 JZ @Ya @Rodell1: //test par 1 octet MOV AL,BYTE ptr[EDI] CMP AL,BYTE PTR[ESI] JNZ @Nann INC ESI INC EDI DEC EDX JNZ @Rodell1 @Ya: XOR EAX,EAX INC EAX POP EDI POP ESI RET @Nann: XOR EAX,EAX POP EDI POP ESI @Distagan: RET end;
Bonsoir,
J'étais tout à l'abri
sous ce toit de campagne
et regardais la pluie
tomber du ciel de Bretagne
De juillet à début Septembre.
J'ai regardé CompareSTR, il parait difficile de faire plus vite.
par contre la double table de saut est efficace à partir d'une vingtaine
d'octets
Je pense avoir localisé une autre partie du code qui cause la lenteur des appels à ChercheDans après avoir créé la routine BMH_CompareSTR basée sur le même modèle que BMH_PosEXD mais qui utilise directement CompareSTR mais avec une SkipTable beaucoup plus simple à utiliser :
Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de ZOLA de 1 048 842 caractères et Mot présent 1 fois à la fin du Texte
Compilé avec array[Byte] of Integer :
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 751 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 128 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 128 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec V2C.chercheDans => Trouvé : 10 000 fois, Mis : 26 894 ms
- Avec BMH_CompareSTR => Trouvé : 10 000 fois, Mis : 8 237 ms
D'où un facteur de gain de vitesse de 26 894 / 8 237 = 3,26 grâce au changement de la SkipTable. Mais bon les 8 237 ms de BMH_CompareSTR restent importants comparativement aux routines qui mettent 1 981 ms ou 1 997 ms et qui n'utilisent pas CompareSTR.
function BMH_CompareSTR(const Mot, Texte: AnsiString; var Depuis: integer): integer; var rm, im, it, ik, LM, LT, Po, PoP: integer; ok: boolean; begin Result := 0; LM := Length(Mot); LT := length(Texte); if (LM = 0) or (LT = 0) then EXIT; if (Depuis = 1) then Depuis := 0; ik := Depuis + LM; while (ik <= LT) do begin it := ik; im := LM; rm := LM - 1; if (Texte[it] = Mot[im]) and (Texte[it - rm] = Mot[1]) then begin PoP := it - LM; ok := CompareSTR(Mot, Texte, PoP); if ok then begin Result := PoP; Depuis := PoP + LM; EXIT; // Trouvé end; end; Inc(ik, skip22[Texte[ik]]); end; Result := 0; Depuis := 0; end;
Vous remarquerez ci-dessus que Inc(ik, skip22[Texte[ik]]); est beaucoup plus simple que l'instruction ci-après qui figure dans T2chars.chercheDans : K := K + Par2chars^[arNchar[ord(Texte[Pred(LsubSTR) + K])] + arNchar[ord(Texte[LsubSTR + K])] * Nlignes];
Donc, pour bénéficier du facteur de gain de vitesse de 3,26 la modification est simple à faire, il ne resterait plus qu'à trouver une astuce qui améliorerait la vitesse de CompareSTR.
Suite à [Erreur] _T2charsPiette.pas(59): Erreur de syntaxe de l'assembleur en ligne j'ai remplacé le Ya? par Yab
Ensuite les tests fonctionnent très bien avec des Mots à nombre de caractères multiples de 4 mais il y a une surprise avec les tests de vitesse :
B) Résultats des tests comparatifs de vitesses :
B1) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 416 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 386 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 400 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 5 616 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 855 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 3 417 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 341 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 1 046 ms
B2) Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de ZOLA de 1 048 842 caractères et Mot présent 1 fois à la fin du Texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 996 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 982 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 767 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 112 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 127 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec V2C.chercheDans => Trouvé : 10 000 fois, Mis : 26 895 ms
Bizarre cette subite lenteur : ???
>> A propos de "trop pressé entre valises et clavier". Au fait, c'est indiscret de vous demander de quand à quand vous partez avec vos valises ??? Car je pense qu'on n'en pas fini à améliorer les codes.
Bonjour,
Oui bien vu j'ai laissé un grain de riz dans mon sel, trop pressé entre valises et clavier.
Je remets à jour _T2charsCL
le problème c'est l'absence de : JZ @Ya? dans function compareSTR.
une boucle cherche par 4 chars en même temps et une autre cherche
la fin entre 1 et 3 char par char, encore faut-il tester que la fin n'est pas 0 ? ce que je n'ai pas fait, KR85 dit il faut tester toujours, et toujours c'est sans fin!
Vous pouvez récupérer cette fonction pour la greffer dans les autres routines cela fonctionne ou doit fonctionner....j'espère.
voir la mise à jour ci dessus.
Salutations
Je change d'avis car je ne retrouve pas _T2charsCL
voici donc ci dessous la version corrigée:
unit _T2charsCL; //recherche type BMH avec 2 caractéres 1° char=colonne 2° char=ligne interface
uses SysUtils;
Const ctNchar = 255;
type TarNchar = array[0..ctNchar] of Byte; Tar2chars = array[0..ctNchar*ctNchar] of Word; TPar2chars = ^Tar2chars;
T2chars = class(Tobject) private arNchar : TarNchar; Par2chars : TPar2chars; SubSTR : string; LsubSTR,Nlignes : Word; Volar2chars : integer; // en octets procedure visualise_table; public Ndiff : Byte; //Nb char différents function Fab_Sauts(Const Mot : string): boolean; //Mot = 2 char mini function chercheDans(Const Texte : string; var Depuis: Cardinal; jusqua: Cardinal=0) : integer; Destructor Destroy; override; end;
implementation
{ T2chars }
function compareSTR(Const S1,S2: AnsiString; OffsetS2: integer): boolean; Register; ASM //eax=ptr(S1) edx=ptr(S2) ecx=OffsetS2 PUSH ESI PUSH EDI MOV ESI,EAX //ESI = ptr(S1) MOV EDI,EDX ADD EDI,ECX //ptr(S2[offsetS2]) MOV ECX,[ESI-4] // ECX = len(S1) MOV EDX,ECX SHR ECX,2 //lenS1 DIV 4 AND ECX,ECX JZ @Dilost4 @Rodell4: //test par 4 octets MOV EAX,DWORD ptr[ESI] CMP EAX,DWORD ptr[EDI] JNZ @Nann ADD ESI,4 ADD EDI,4 DEC ECX JNZ @Rodell4 @Dilost4: AND EDX,$00000003 // EDX modulo 4 -> 0..3 JZ @Ya? //<***********************************************modification faite ici @Rodell1: //test par 1 octet MOV AL,BYTE ptr[ESI] CMP AL,BYTE PTR[EDI] JNZ @Nann INC ESI INC EDI DEC EDX JNZ @Rodell1 @Ya?: POP EDI POP ESI XOR EAX,EAX INC EAX RET //Result=true @Nann: POP EDI POP ESI XOR EAX,EAX RET //Result=false end;
procedure fillWord(var X; Count: Integer; Value: Word); Register; asm PUSH EDI MOV EDI,EAX //var X MOV AX,CX //Value MOV ECX,EDX //Count CLD REP STOSW POP EDI end;
destructor T2chars.Destroy; begin if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); inherited; end;
function T2chars.Fab_Sauts(const Mot: string): boolean; var I : integer; begin Result:=length(Mot) > 1; if not Result then exit; SubSTR:=Mot; LsubSTR:=length(SubSTR); fillchar(arNchar,succ(ctNchar),0); //comptage Nb lettres <> for I := 1 to LsubSTR do arNchar[ord(SubSTR[I])]:=1; Ndiff:=1; for I := 0 to Pred(ord(SubSTR[1])) do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; for I := Succ(ord(SubSTR[1])) to ctNchar do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; Nlignes:=Succ(Ndiff); if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); Volar2chars:=(Nlignes*Nlignes*sizeof(Word)); GetMem(Par2chars,Volar2chars); fillWord(Par2chars^,Nlignes*Nlignes,LsubSTR); fillWord(Par2chars^,Nlignes*2,Pred(LsubSTR)); //remplissage de la table for I := 1 to LsubSTR-2 do Par2chars^[arNchar[ord(subSTR[I])]+ arNchar[ord(subSTR[Succ(I)])]*Nlignes]:=Pred(LSubSTR)-I; visualise_table; end;
function T2chars.chercheDans(const Texte: string; var Depuis: Cardinal; jusqua: Cardinal=0): integer; var LT,K : Cardinal;
begin Result:=0; LT:=length(Texte); if (Jusqua > Depuis) and (jusqua < LT) then LT:=jusqua; K:=Pred(Depuis); while (LsubSTR+K)<= LT do begin if compareSTR(SubSTR,Texte,K) then begin Result:=Succ(K); Depuis:=Result+LsubSTR; exit; end; //trouve K:=K+Par2chars^[arNchar[ord(Texte[Pred(LsubSTR)+K])]+ arNchar[ord(Texte[LsubSTR+K])]*Nlignes]; end; end;
procedure T2chars.visualise_table; var I,J : integer; S : string; function A2(W:Word): string; begin Result:=intToSTR(W); if length(Result) = 1 then Result:='0'+Result; end; begin writeln('Masque = char1 dans colonne char2 dans ligne 0=inconnus'); writeln(SubSTR); writeln(Ndiff,' chars'); SetLength(S,Ndiff); for I := 0 to ctNchar do if arNchar[I] <> 0 then S[arNchar[I]]:=chr(I); write(' 0 '); for I := 1 to Ndiff do write(S[I],' '); writeln; //scrute table for I := 0 to Ndiff do Begin if I = 0 then write('0 ') else write(S[I],' '); for J := 0 to Ndiff do write(A2(Par2chars^[I*Nlignes+J]),' '); writeln; end; readln; end;
En continuant les tests avec divers bouts de Phrase j'ai mis le doigt sur une bizarrerie obtenue avec V2C.chercheDans :
Pour 10 000 - Recherches de Bout de phrase de 32 caractères dans Texte de ZOLA de 1 048 842 caractères Bout de phrase présent 2 fois dans le texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 20 000 fois, Mis : 7 270 ms
- Avec posEXD ASM de Piette => Trouvé : 20 000 fois, Mis : 7 300 ms
- Avec PosDJ ASM de Piette => Trouvé : 20 000 fois, Mis : 7 286 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 20 000 fois, Mis : 3 260 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 20 000 fois, Mis : 2 824 ms
- Avec BMHPascalNaifEx => Trouvé : 20 000 fois, Mis : 2 870 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 20 000 fois, Mis : 7 317 ms
- Avec V2C.chercheDans => Trouvé : 0 fois, Mis : 3 010 ms
Et cette bizarrerie se manifeste également en recherchant un Mot de 12 caractères et idem avec un Mot de 4 caractères
On dirait que V2C.chercheDans a un problème avec les Mots à nombre de caractères multiple de 4.
Est-ce-que cette bizarrerie se produit aussi chez quelqu'un d'autre ???
Réponse au message de Cirec du 28 juin 2015 à 15:13
>> "... mais ou sont les résultats de BMHPascalNaifEx ??" :
J'avais placé BMHPascalNaifEx entre crochets de commentaires vu qu'elle donne chez moi des résultats très voisins de BMHPascalNaif.":
Du coup je la fais participer de nouveau dans les tests suivants.
>> "...sinon j'avais oublié de précisé que les mots & les textes utilisés pour la recherche ne sont pas de type aléatoires mais de "vrais" textes:" :
Du coup j'ai fait un test avec la recherche d'une "vraie" Phrase dans un "vrai" texte de ZOLA d'environ 1 Mo
A) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 401 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 416 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 464 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 4 352 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 886 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 3 447 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 529 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 1 014 ms
B) Pour 100 000 - Recherches de Phrase de 821 caractères dans Texte de ZOLA de 1 048 842 caractères et Phrase présente en fin du texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 100 000 fois, Mis : 20 483 ms
- Avec posEXD ASM de Piette => Trouvé : 100 000 fois, Mis : 20 499 ms
- Avec PosDJ ASM de Piette => Trouvé : 100 000 fois, Mis : 20 498 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 100 000 fois, Mis : 6 974 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 100 000 fois, Mis : 6 427 ms
- Avec BMHPascalNaifEx => Trouvé : 100 000 fois, Mis : 6 411 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 100 000 fois, Mis : 6 490 ms
- Avec V2C.chercheDans => Trouvé : 100 000 fois, Mis : 4 789 ms
Cordialement, et à +.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 28 juin 2015 à 15:13
des testes encore des testes ...
j'ai vu que tu as reproduit la recherche de 175 caractères aléatoires dans Texte de 97 351 caractères
mais ou sont les résultats de BMHPascalNaifEx ??
sinon j'avais oublié de précisé que les mots & les textes utilisés pour la recherche ne sont pas de type aléatoires mais de "vrais" textes:
Mot est une ou plusieurs lignes de code
et Texte un Code Source ...
et ce type de recherche met à mal les performances de BMH_PosEXD surtout si Mot commence par un ou deux espaces et finit par un retour chariot (CRLF #13#10)
Et ces 3 caractères sont logiquement présents et dans tous les textes et en très grande quantité ... ce qui change tout aux résultats
Si je recherche Mot sans espaces et sans retour chariot :
BMH_PosEXD & BMHPascalNaifEx sont au coude à coude
Avec BMHPascalNaif => Trouvé : 16 fois, Mis : 312 ms dont 312 ms uniquement pour les appels à BMHPascalNaif
Avec BMHPascalNaifEx => Trouvé : 16 fois, Mis : 234 ms dont 234 ms uniquement pour les appels à BMHPascalNaifEx
Avec PosExD => Trouvé : 16 fois, Mis : 1 266 ms dont 1 266 ms uniquement pour les appels à PosExD
Avec BMH_PosEXD => Trouvé : 16 fois, Mis : 250 ms dont 250 ms uniquement pour les appels à BMH_PosEXD
mais si tu veux rechercher un plagiat tu auras forcément des retours chariots et peut être des espaces.
Donc pour faciliter le tout j'utilise le Presse-Papier ... on sélectionne un texte avec la souri ... Ctrl+C et je l'utilise directement pour la recherche ... ça permet de changer le contenu et la taille de Mot très facilement et de relancer le teste dans la foulée
Cirec "ah oui ... j'ai également testé sur le i7 le "problème" du (My)GetTickCount et aucun soucis à déclarer !!!" :
Donc c'est mon Intel Core i7 - 2700 K à 3, 5 GHz qui a une faille !!!???
Et voici les résultats des tests comparatifs de vitesses avec la version de code de V2C.chercheDans de Piette d'aujourd'hui le 28 juin 2015 à 11:27 avec "une pincée de sel ASM" supplémentaire et avec GetTickCount :
A) Pour 10 000 - Recherches de Mot de 175 caractères aléatoires dans Texte de 97 351 caractères alétoires et Mot présent 16 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 160 000 fois, Mis : 203 ms
- Avec posEXD ASM de Piette => Trouvé : 160 000 fois, Mis : 187 ms
- Avec PosDJ ASM de Piette => Trouvé : 160 000 fois, Mis : 187 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 160 000 fois, Mis : 62 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 160 000 fois, Mis : 32 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 160 000 fois, Mis : 31 ms
- Avec V2C.chercheDans => Trouvé : 160 000 fois, Mis : 47 ms
B) Pour 100 000 - Recherches de Mot de 175 caractères aléatoires dans Texte de 97 351 caractères alétoires et Mot présent 16 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 1 600 000 fois, Mis : 1 903 ms
- Avec posEXD ASM de Piette => Trouvé : 1 600 000 fois, Mis : 1 903 ms
- Avec PosDJ ASM de Piette => Trouvé : 1 600 000 fois, Mis : 1 888 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 1 600 000 fois, Mis : 530 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 452 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 328 ms
- Avec V2C.chercheDans => Trouvé : 1 600 000 fois, Mis : 515 ms
C) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 292 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 322 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 308 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 6 754 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 887 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 513 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 1 029 ms
D) Pour Recherches de Mot de 510 caractères aléatoires dans 1 000 000 Textes de 15 300 caractères alaétoires : Mot présent 10 fois uniquement dans le dernier texte
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 2 823 ms
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 2 793 ms
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 327 ms dont
Sauts bridés par array[char] of Byte
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 fois, Mis : 109 ms (grâce à table de sauts en LongWord)
- Avec V2C.chercheDans => Trouvé : 10 fois, Mis : 250 ms
En attendant les tests de la nouvelle version de code de Piette postée aujourd'hui 28 juin 2015 à 11:27, voici déjà les résultats des tests comparatifs de vitesse obtenus chez moi avec sa version précédente avec GetTickCount .
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 301 caractères alétoires : (Mot présent 10 fois dans chaque texte)
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 167 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 167 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 214 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 4 165 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 886 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 513 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 4 680 ms
Pour 10 000 - Recherches de Mot de 175 caractères aléatoires dans Texte de 97 351 caractères alétoires et Mot présent 16 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 160 000 fois, Mis : 218 ms
- Avec posEXD ASM de Piette => Trouvé : 160 000 fois, Mis : 188 ms
- Avec PosDJ ASM de Piette => Trouvé : 160 000 fois, Mis : 187 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 160 000 fois, Mis : 62 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 160 000 fois, Mis : 47 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 160 000 fois, Mis : 31 ms
- Avec V2C.chercheDans => Trouvé : 160 000 fois, Mis : 78 ms
Bonjour,
Une pincée de sel ASM dans la soupe Delphi améliore la vitesse de cuisson!
unit _T2charsCL; //recherche type BMH avec 2 caractéres 1° char=colonne 2° char=ligne interface
uses SysUtils;
Const ctNchar = 255;
type TarNchar = array[0..ctNchar] of Byte; Tar2chars = array[0..ctNchar*ctNchar] of Word; TPar2chars = ^Tar2chars;
T2chars = class(Tobject) private arNchar : TarNchar; Par2chars : TPar2chars; SubSTR : string; LsubSTR,Nlignes : Word; Volar2chars : integer; // en octets procedure visualise_table; public Ndiff : Byte; //Nb char différents function Fab_Sauts(Const Mot : string): boolean; //Mot = 2 char mini function chercheDans(Const Texte : string; var Depuis: Cardinal; jusqua: Cardinal=0) : integer; Destructor Destroy; override; end;
implementation
{ T2chars }
function compareSTR(Const S1,S2: AnsiString; OffsetS2: integer): boolean; Register; ASM //eax=ptr(S1) edx=ptr(S2) ecx=OffsetS2 PUSH ESI PUSH EDI MOV ESI,EAX //ESI = ptr(S1) MOV EDI,EDX ADD EDI,ECX //ptr(S2[offsetS2]) MOV ECX,[ESI-4] // ECX = len(S1) MOV EDX,ECX SHR ECX,2 //lenS1 DIV 4 AND ECX,ECX JZ @FB4 @B4: //test par 4 octets MOV EAX,DWORD ptr[ESI] CMP EAX,DWORD ptr[EDI] JNZ @PB ADD ESI,4 ADD EDI,4 DEC ECX JNZ @B4 @FB4: AND EDX,$00000003 // EDX 1..3 @B1: //test par 1 octet MOV AL,BYTE ptr[ESI] CMP AL,BYTE PTR[EDI] JNZ @PB INC ESI INC EDI DEC EDX JNZ @B1 POP EDI POP ESI XOR EAX,EAX INC EAX RET @PB: POP EDI POP ESI XOR EAX,EAX RET end;
procedure fillWord(var X; Count: Integer; Value: Word); Register; asm PUSH EDI MOV EDI,EAX //var X MOV AX,CX //Value MOV ECX,EDX //Count CLD REP STOSW POP EDI end;
destructor T2chars.Destroy; begin if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); inherited; end;
function T2chars.Fab_Sauts(const Mot: string): boolean; var I : integer; begin Result:=length(Mot) > 1; if not Result then exit; SubSTR:=Mot; LsubSTR:=length(SubSTR); fillchar(arNchar,succ(ctNchar),0); //comptage Nb lettres <> for I := 1 to LsubSTR do arNchar[ord(SubSTR[I])]:=1; Ndiff:=1; for I := 0 to Pred(ord(SubSTR[1])) do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; for I := Succ(ord(SubSTR[1])) to ctNchar do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; Nlignes:=Succ(Ndiff); if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); Volar2chars:=(Nlignes*Nlignes*sizeof(Word)); GetMem(Par2chars,Volar2chars); fillWord(Par2chars^,Nlignes*Nlignes,LsubSTR); fillWord(Par2chars^,Nlignes*2,Pred(LsubSTR)); //remplissage de la table for I := 1 to LsubSTR-2 do Par2chars^[arNchar[ord(subSTR[I])]+ arNchar[ord(subSTR[Succ(I)])]*Nlignes]:=Pred(LSubSTR)-I; //visualise_table; end;
function T2chars.chercheDans(const Texte: string; var Depuis: Cardinal; jusqua: Cardinal=0): integer; var LT,K : Cardinal;
begin Result:=0; LT:=length(Texte); if (Jusqua > Depuis) and (jusqua < LT) then LT:=jusqua; K:=Pred(Depuis);
while (LsubSTR+K)<= LT do begin if compareSTR(SubSTR,Texte,K) then begin Result:=Succ(K); Depuis:=Result+LsubSTR; exit; end; //trouve K:=K+Par2chars^[arNchar[ord(Texte[Pred(LsubSTR)+K])]+ arNchar[ord(Texte[LsubSTR+K])]*Nlignes]; end; end;
procedure T2chars.visualise_table; var I,J : integer; S : string; function A2(W:Word): string; begin Result:=intToSTR(W); if length(Result) = 1 then Result:='0'+Result; end; begin writeln('Masque = char1 dans colonne char2 dans ligne 0=inconnus'); writeln(SubSTR); writeln(Ndiff,' chars'); SetLength(S,Ndiff); for I := 0 to ctNchar do if arNchar[I] <> 0 then S[arNchar[I]]:=chr(I); write(' 0 '); for I := 1 to Ndiff do write(S[I],' '); writeln; //scrute table for I := 0 to Ndiff do Begin if I = 0 then write('0 ') else write(S[I],' '); for J := 0 to Ndiff do write(A2(Par2chars^[I*Nlignes+J]),' '); writeln; end; readln; end;
end.
Salutations
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 27 juin 2015 à 16:59
Bonjour,
Merci pour les compliments,
c'est un plaisir partagé d'avoir confronté nos programmes.
Bonnes vacances.
Bonjour a vous deux,
Les vacances approchent finissons-en (avec le boulot).
Je vous livre une version à 2 chars qui fonctionne bien (à tester plus profondément).
Il y avait une difficulté avec le masque à deux chars en particulier le second char,
j'ai résolu ceci sans test en modifiant la table (que l'on peut voir).
Je fais ceci avec D5 (qui ne veut plus dépasser XP).
j'utilise W8+OracleVirtualBox+XP
voila: l'unité puis le testeur
unit _T2charsCL; //recherche type BMH avec 2 caractéres 1° char=colonne 2° char=ligne interface
uses SysUtils;
Const ctNchar = 255;
type TarNchar = array[0..ctNchar] of Byte; Tar2chars = array[0..ctNchar*ctNchar] of Word; TPar2chars = ^Tar2chars;
T2chars = class(Tobject) private arNchar : TarNchar; Par2chars : TPar2chars; SubSTR : string; LsubSTR,Nlignes : Word; Volar2chars : integer; // en octets procedure visualise_table; public Ndiff : Byte; //Nb char différents function Fab_Sauts(Const Mot : string): boolean; //Mot = 2 char mini function chercheDans(Const Texte : string; var Depuis: Cardinal; jusqua: Cardinal=0) : integer; Destructor Destroy; override; end;
implementation
{ T2chars }
procedure fillWord(var X; Count: Integer; Value: Word); Register; asm PUSH EDI MOV EDI,EAX //var X MOV AX,CX //Value MOV ECX,EDX //Count CLD REP STOSW POP EDI end;
destructor T2chars.Destroy; begin if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); inherited; end;
function T2chars.Fab_Sauts(const Mot: string): boolean; var I : integer; begin Result:=length(Mot) > 1; if not Result then exit; SubSTR:=Mot; LsubSTR:=length(SubSTR); fillchar(arNchar,succ(ctNchar),0); //comptage Nb lettres <> for I := 1 to LsubSTR do arNchar[ord(SubSTR[I])]:=1; Ndiff:=1; for I := 0 to Pred(ord(SubSTR[1])) do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; for I := Succ(ord(SubSTR[1])) to ctNchar do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; Nlignes:=Succ(Ndiff); if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); Volar2chars:=(Nlignes*Nlignes*sizeof(Word)); GetMem(Par2chars,Volar2chars); fillWord(Par2chars^,Nlignes*Nlignes,LsubSTR); fillWord(Par2chars^,Nlignes*2,Pred(LsubSTR)); //remplissage de la table for I := 1 to LsubSTR-2 do Par2chars^[arNchar[ord(subSTR[I])]+ arNchar[ord(subSTR[Succ(I)])]*Nlignes]:=Pred(LSubSTR)-I; //visualise_table; end;
function T2chars.chercheDans(const Texte: string; var Depuis: Cardinal; jusqua: Cardinal=0): integer; var LT,P,I,K : integer; begin Result:=0; LT:=length(Texte); if (Jusqua > Depuis) and (jusqua < LT) then LT:=jusqua; K:=0; K:=Pred(Depuis);
while (LsubSTR+K)<= LT do begin P:=LsubSTR; Repeat if SubSTR[P]=Texte[P+K] then dec(P) else P:=-1; Until P <= 0; if P = 0 then begin Result:=Succ(K); Depuis:=Result+LsubSTR; exit; end; //trouve K:=K+Par2chars^[arNchar[ord(Texte[Pred(LsubSTR)+K])]+ arNchar[ord(Texte[LsubSTR+K])]*Nlignes]; end; end;
procedure T2chars.visualise_table; var I,J : integer; S : string; function A2(W:Word): string; begin Result:=intToSTR(W); if length(Result) = 1 then Result:='0'+Result; end; begin writeln('Masque = char1 dans colonne char2 dans ligne 0=inconnus'); writeln(SubSTR); writeln(Ndiff,' chars'); SetLength(S,Ndiff); for I := 0 to ctNchar do if arNchar[I] <> 0 then S[arNchar[I]]:=chr(I); write(' 0 '); for I := 1 to Ndiff do write(S[I],' '); writeln; //scrute table for I := 0 to Ndiff do Begin if I = 0 then write('0 ') else write(S[I],' '); for J := 0 to Ndiff do write(A2(Par2chars^[I*Nlignes+J]),' '); writeln; end; readln; end;
end.
Puis le testeur avec explication du dernier char du maque:
program test_2charsCL; {$APPTYPE CONSOLE} uses sysutils,windows, _T2charsCL in '_T2charsCL.pas';
Function MyGetTickCount: Int64; Var lpPerformanceCount, lpFrequency : Int64; Begin If Not QueryPerformanceCounter(lpPerformanceCount) Then lpPerformanceCount := GetTickCount Else Begin QueryPerformanceFrequency(lpFrequency); lpPerformanceCount := (lpPerformanceCount * 1000) Div lpFrequency End;
result := lpPerformanceCount; End; begin // Insérer le code utilisateur ici V2C:=T2chars.Create; SubSTR:='-xEabc'; V2C.Fab_Sauts(SubSTR); //PARTICULARITES DU TRAITEMENT SECOND CHAR DU MASQUE //masque W- : Masque inconnu dans SubSTR mais second char peut être connu // comme ici donc saut: len-1 D:=5; J:=11; write('pos:',V2C.chercheDans('-xEaW-xEabc',D,J)); writeln(' D:',D); //masque E- : Masuqe avec lettres connus dans subSTR mais dans mauvais ordre avec // second char = début de SubSTR donc saut : len-1 D:=4; write('pos:',V2C.chercheDans('-xEaE-xEabc',D)); writeln(' D:',D); //masque bx : Masque avec lettres connus mais second char différent du premier //de subSTR donc saut : len D:=2; write('pos:',V2C.chercheDans('xEabEx-xEabc',D)); writeln(' D:',D);
SubSTR:='Bonjour de Bretagne ou il fait beau'; SubSTR:=SubSTR+' et re'+SubStr+', bonnes vacances'; writeln('len SubSTR : ',length(SubSTR)); if V2C.Fab_Sauts(SubSTR) then begin SubSTR:='-'+SubSTR+'-'+SubSTR+'-'+SubSTR+'-'+SubSTR; writeln('len STR : ',length(SubSTR)); N:=0; G:=MyGetTickCount; for I := 1 to 1000000 do begin D:=1; while V2C.chercheDans(SubSTR,D) <> 0 do inc(N); end; G:=MyGetTickCount-G; writeln(N,' trouvailles en ',G,' ms'); end; readln; V2C.Free; end.
Bonnes vacances.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 Modifié par Cirec le 27/06/2015 à 16:29
re,
en premier je veux féliciter Piette pour son excellent travail et en particulier sur la partie ASM ...
chapeau bas Monsieur et Merci pour le partage ;)
et si j'ai bien compris ... passe de bonnes vacances !!!
Sinon pour les testes .. vu qu'on utilise tous un compilateur différent (Piette en D5 je crois, Pseudo3 en D6, et moi en D7 ou D2009) et que ce détail a toute son importance puisque chez moi, après de nouveaux testes, BMHPascalNaifEx reste très régulièrement en tête et parfois même de manière écrasante:
Pour 10 000 - Recherches de 175 Caractères dans 97 351 Caractères: sous D7
Avec PosBM_Mickey974ModifExPChar => Trouvé : 16 fois, Mis : 250 ms dont 250 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec BMHPascalNaif => Trouvé : 16 fois, Mis : 219 ms dont 219 ms uniquement pour les appels à BMHPascalNaif
Avec BMHPascalNaifEx => Trouvé : 16 fois, Mis : 187 ms dont 187 ms uniquement pour les appels à BMHPascalNaifEx
Avec PosExD => Trouvé : 16 fois, Mis : 1 344 ms dont 1 344 ms uniquement pour les appels à PosExD
Avec BMH_PosEXD => Trouvé : 16 fois, Mis : 1 094 ms dont 1 078 ms uniquement pour les appels à BMH_PosEXD
Teste Terminé
et que depuis D2009 Delphi est en Unicode du coup les versions ASM & PByte ne fonctionnent pas (en l'état) mais c'est la version PChar qui tient le haut du pavé.
Pour 10 000 - Recherches de 175 Caractères dans 97 351 Caractères: sous D2009
Avec PosBM_Mickey974ModifExPChar => Trouvé : 16 fois, Mis : 297 ms dont 297 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec BMHPascalNaif => Trouvé : 16 fois, Mis : 781 ms dont 781 ms uniquement pour les appels à BMHPascalNaif
Avec BMHPascalNaifEx => Trouvé : 16 fois, Mis : 578 ms dont 578 ms uniquement pour les appels à BMHPascalNaifEx
on a donc sous D7
BMHPascalNaifEx à + 80% en tête
le reste du temps est partagé entre L'ASM et BMH_PosEXD
et sous D2009
PosBM_Mickey974ModifExPChar qui reste invariablement en tête.
tout ça pour dire qu'on ne se bat pas à armes égales et qu'il est difficile de comparer notre travail. Alors que le code source est identique pour tous le code machine (compilé) produit, lui est différent en fonction du compilateur utilisé. Il n'y a donc pas de comparaison possible ... sauf peut être pour les versions ASM
ah oui ... j'ai également testé sur le i7 le "problème" du (My)GetTickCount et aucun soucis à déclarer !!!
Réponse au message de Piette du 26 juin 2015 à 23:46
>> "Je vous propose un 1° jet de BMH avec 2 caractères . Ceci devrait être plus rapide?" :
Si on appelle la function T2chars.chercheDans(const Texte: string): integer dans une boucle elle revoie systématiquement la position de la première occurrence donc ça fausse la compétition.
Il faudrait la modifier comme suit function T2chars.chercheDans(const Texte: string; var PositionDepuisSuivante : integer): integer; pour pouvoir l'obliger à chercher les occurrences suivantes.
Bonsoir,
En Effet.
J'ai lâché l'ASM pour regarder de plus près BMH que vous m'avez fait découvrir.
Je vous propose un 1° jet de BMH avec 2 caractères . Ceci devrait être plus rapide?
Voici pour voir:
unit _T2chars; //recherche type BMH avec 2 caractéres interface
uses SysUtils;
Const ctNchar = 255;
type TarNchar = array[0..ctNchar] of Byte; Tar2chars = array[0..ctNchar*ctNchar] of Word; TPar2chars = ^Tar2chars;
T2chars = class(Tobject) private arNchar : TarNchar; Par2chars : TPar2chars; SubSTR : string; LsubSTR,Nlignes : Word; Volar2chars : integer; // en octets procedure visualise_table; public Ndiff : Byte; //Nb char différents function Fab_Sauts(Const Mot : string): boolean; function chercheDans(Const Texte : string) : integer; Destructor Destroy; override; end;
implementation
{ T2chars }
procedure fillWord(var X; Count: Integer; Value: Word); Register; asm PUSH EDI MOV EDI,EAX //var X MOV AX,CX //Value MOV ECX,EDX //Count CLD REP STOSW POP EDI end;
destructor T2chars.Destroy; begin if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); inherited; end;
function T2chars.Fab_Sauts(const Mot: string): boolean; var I : integer; begin Result:=length(Mot) > 2; if not Result then exit; SubSTR:=Mot; LsubSTR:=length(SubSTR); fillchar(arNchar,succ(ctNchar),0); //comptage Nb lettres <> for I := 1 to LsubSTR do arNchar[ord(SubSTR[I])]:=1; Ndiff:=0; for I := 0 to ctNchar do if arNchar[I] <> 0 then begin inc(Ndiff); arNchar[I]:=Ndiff; end; Nlignes:=Succ(Ndiff); //table 2 chars if Par2chars <> NIL then FreeMem(Par2chars,Volar2chars); Volar2chars:=(Nlignes*Nlignes*sizeof(Word)); GetMem(Par2chars,Volar2chars); fillWord(Par2chars^,Volar2chars DIV sizeof(Word),LsubSTR); //remplissage de la table for I := 1 to LsubSTR-2 do Par2chars^[arNchar[ord(subSTR[I])]*Nlignes+ arNchar[ord(subSTR[Succ(I)])]]:=Pred(LSubSTR)-I; //visualise_table; end;
function T2chars.chercheDans(const Texte: string): integer; var LT,P,I,K : integer; begin Result:=0; LT:=length(Texte); if LT < LsubSTR then exit; K:=0; while (LsubSTR+K)<= LT do begin P:=LsubSTR; Repeat if SubSTR[P]=Texte[P+K] then dec(P) else P:=-1; Until P <= 0; if P = 0 then begin Result:=Succ(K); exit; end; //trouve K:=K+Par2chars^[arNchar[ord(Texte[Pred(LsubSTR)+K])]*Nlignes+ arNchar[ord(Texte[LsubSTR+K])]]; end; end;
procedure T2chars.visualise_table; var I,J : integer; S : string; function A2(W:Word): string; begin Result:=intToSTR(W); if length(Result) = 1 then Result:='0'+Result; end; begin writeln(SubSTR); writeln(Ndiff,' chars'); S:=''; for I := 0 to ctNchar do if arNchar[I] <> 0 then S:=S+chr(I); write(' 0 '); for I := 1 to Ndiff do write(S[I],' '); writeln; //scrute table for I := 0 to Ndiff do Begin if I = 0 then write('0 ') else write(S[I],' '); for J := 0 to Ndiff do write(A2(Par2chars^[I*Nlignes+J]),' '); writeln; end; readln; end;
end.
Puis le testeur:
program test_2chars; {$APPTYPE CONSOLE} uses sysutils, _T2chars in '_T2chars.pas';
var v2c : T2chars; I : integer; SubSTR , STR : string; begin // Insérer le code utilisateur ici V2C:=T2chars.Create; SubSTR:='aabcaab'; V2C.Fab_Sauts(SubSTR); writeln(V2C.chercheDans('--acbcaa-bcaabbbccbcaab-aabcaab')); readln; V2C.Free; end.
Je prends le large dans quelques jours sans clavier
Bonne vacances
Voici un test comparatif de vitesses qui illustre l'avantage du Boyer-Moore : lorsqu'on recherche un Mot ou une phrase longs dans beaucoup de textes dans lequel il est absent sauf une poignée d'entre-eux il traverse les premiers à grands sauts égaux à LenSub tandis que les autres codes rament dans la choucroute :
Résultats pour Recherches d'un Mot de 510 caractères aléatoires dans 1 000 000 Textes de 15 300 caractères alétoires : Mot présent 10 fois uniquement dans le dernier texte :
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 2 839 ms dont 2 761 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 2 824 ms dont 46 ms uniquement pour les appels à posEXD
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 fois, Mis : 109 ms dont 94 ms uniquement pour les appels à BMH_PosEXD
Soit une vitesse multipliée par 26 dans le cas d'un Mot ou d'une phrase de 510 caractères.
Oups, il manque un bout de code pour pouvoir utiliser le code de BMH_PosEXD : j'ai oublié celui de InitSkip22
type tSkip22 = array[char] of longWord; //< Pour bénéficier pleinement des performances du Boyer-Moore il faut éviter de le brider avec un array[char] of byte. var Skip22: tSkip22;
procedure InitSkip22(const Mot: string); // Initialisation de la SkipTable avant les appels répétitifs à BMH_PosEXD var LM, k: integer; Cara: char; begin LM := Length(Mot); for Cara := low(Char) to high(Char) do Skip22[Cara] := LM; for k := 1 to LM - 1 do Skip22[Mot[k]] := LM - k; end;
Réponse aux messages de Piette du 25 juin 2015 à 19:06 et de Cirec du 26 juin 2015 à 12:28
>> Concernant MyGetTickCount : Je viens aussi de comparer la version de MyGetTickCount de Cirec à GetTickCount et ça me donne aussi des durées environ 3 fois supérieures à celles de GetTickCount (Intel Core i7 - 2700 K à 3,5 GHz, sous Windows 7 premium)
Mais bon on peut se contenter de GetTickCount dès lors que les tests comparatifs de vitesse sont tels que toutes les durées sont suffisamment grandes (il suffit d'augmenter le nombre de boucles d'appels de sorte que chaque durée est supérieure à une seconde)
De toutes façons avec ou sans GetTickCount, avec ou sans MyGetTickCount, il paraît que Windows prend la main quand ça lui chante pour la rendre quand ça lui chante.
>> Concernant BMHPascalNaifEx Si "tout est ok" chez Cirec alors tant mieux
Il y a effectivement des erreurs et des différences de comportement que je suis le seul à avoir, mais comme l'erreur ne se produit qu'avec des Mots d'un seul caractère et que je ne recherche jamais de tels mots on peut laisser tomber vu que ça règle le problème.
>> Concernant les points forts et faibles de BMHPascalNaif et de posEXD : Comme posEXD qui n'est pas du type Boyer-Moore est plus lente que BMHPascalNaif lorsque la longueur de la SubString est supérieure ou égale à 18 et plus rapide dans les autres cas j'ai créé la fonction BMH_PosEXD qui marie les deux pour bénéficier des points forts des deux :
Voici les résultats de tests comparatifs de vitesse (avec GetTickCount) :
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires : Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 651 ms dont 3 478 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 3 650 ms dont 3 540 ms uniquement pour les appels à posEXD
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 4 774 ms dont 4 697 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 6 708 ms dont 6 536 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 3 588 ms dont 3 509 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 5 507 ms dont 5 383 ms uniquement pour les appels à Pos_BMH
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 fois, Mis : 2 933 ms dont 2 840 ms uniquement pour les appels à BMHPascalNaif
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 fois, Mis : 1 591 ms dont 1 467 ms uniquement pour les appels à BMH_PosEXD
On constate qu'en mariant posEXD à BMHPascalNaif dans BMH_PosEXD la vitesse d'exécution de BMH_PosEXD est multiplée par :
- 1,84 si comparée à BMHPascalNaif
- 2,29 si comparée à posEXD ou à posEX
Et voici le code de BMH_PosEXD :
function BMH_PosEXD(const Mot, Texte: AnsiString; var Depuis: integer): integer; const Seuil: integer = 18; var rm, im, it, ik, LM, LT, Po, PoP: integer; begin Result := 0; LM := Length(Mot); LT := length(Texte); if (LM = 0) or (LT = 0) then EXIT; if LM < Seuil then begin if Depuis < 1 then Depuis := 1; Po := PosExD(Mot, Texte, Depuis); Result := Po; EXIT; end; if (LM >= Seuil) and (Depuis=1) then Depuis := 0; ik := Depuis + LM; while (ik <= LT) do begin it := ik; im := LM; rm := LM - 1; if (Texte[it] = Mot[im]) and (Texte[it - rm] = Mot[1]) then begin //< Concordance sur Dernier et Premier caractère du Mot PoP := it - (LM - 1); Po := PosExD(Mot, Texte, PoP); if Po > 0 then begin Result := Po; Depuis := Po + LM; EXIT; end; end; Inc(ik, skip22[Texte[ik]]); end; Result := 0; Depuis := 0; end;
>> Concernant la nouvelle posDJ(m,T,Depuis,jusqua) de Piette: On peut aussi créer une BMH_PosEXDJ() avec la posDJ() en modifiant légèrement le code ci-dessus pour bénéficier d'un gain de vitesse similaire..
Cordialement, et à +.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 Modifié par Cirec le 26/06/2015 à 12:36
re,
cs_pseudo3- 24 juin 2015 à 11:45
j'avais bien compris et j'avais testé la bonne fonction BMHPascalNaifEx et tout est ok chez moi
quelque chose n'est pas très claire dans tout cela !!
il y a des erreurs et des différences de comportement que tu sembles être le seul à avoir
Idem pour MyGetTickCount qui est connue depuis longtemps et qui fonctionne parfaitement ... je viens de refaire un petit teste entre GetTickCount et MyGetTickCount
Les résultats sont identiques la majorité du temps, pour le reste MyGetTickCount annonce une milliseconde de moins sur un intervalle d'une seconde ... ce qui normal vu sa précision. Mais en aucun cas 3 fois plus de temps !!
On utilise généralement MyGetTickCount pour avoir une plus grande précision ... quand GetTickCount retourne 0 ms MyGetTickCount peut retourner une valeur > 0
j'ai testé sous XP et Seven il me manque qu'un teste sur le i7
sinon la MSDN dit : qu'à partir de XP l'appel à la fonction QueryPerformanceCounter réussit toujours et que la valeur de retour de QueryPerformanceFrequency est défini au Boot et reste la même pour tous les process.
On peut donc écrire MyGetTickCount comme ceci et économiser quelques cycles à chaque appel:
implementation
{$R *.dfm}
var
lpFrequency: Int64;
function MyGetTickCount: Int64;
begin
QueryPerformanceCounter(result);
result := (result * 1000) div lpFrequency ;
end;
initialization
QueryPerformanceFrequency(lpFrequency);
end.
@+ Cirec
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 25 juin 2015 à 19:06
Bonjour,
étonnant ce chrono il fonctionne trés bien avec ma version XP?
j'ai repris posEX pour le modifier complètement comme mon 1° prog
pos(m,T,Depuis,jusqua) c'est
posDJ(m,T,Depuis,jusqua)
il est plus lent d'une nanoseconde que posEXD
mes tests et mon chrono
posEXD = 382 ms
posDJ = 423 ms
Pos = 473 ms
function PosDJ(const SubStr, S: string; var Depuis: Integer; jusqua : integer = 0): Integer; Register; asm //modification de PosEX [ebp+8]=jusqua push ebx cmp eax, 1 sbb ebx, ebx {-1 if SubStr = '' else 0} sub edx, 1 {-1 if S = ''} sbb ebx, 0 {Negative if S = '' or SubStr = '' else 0} PUSH ECX {ptr Depuis} MOV ECX,[ECX] dec ecx {Offset - 1} or ebx, ecx {Negative if S = '' or SubStr = '' or Offset < 1} jl @@InvalidInput push edi push esi push ebp push edx mov edi, [eax-4] {Length(SubStr)} PUSH EDI mov esi, [edx-3] {Length(S)} PUSH EAX //traitement de jusqua MOV EAX,[EBP+8] //jusqua AND EAX,EAX //test 0 JZ @@x CMP EAX,ESI //Depuis,len(S) JA @@x //EAX > ESI MOV ESI,EAX //jusqua remplace len(S) @@x: POP EAX add ecx, edi cmp ecx, esi jg @@NotFound {Offset to High for a Match} test edi, edi jz @@NotFound {Length(SubStr = 0)} lea ebp, [eax+edi] {Last Character Position in SubStr + 1} add esi, edx {Last Character Position in S} // movzx eax, [ebp-1] {Last Character of SubStr ne compile pas en D5} MOV AL,[EBP-1] {remplace movzx} AND EAX,$000000FF {remplace movzx} add edx, ecx {Search Start Position in S for Last Character} mov ah, al neg edi {-Length(SubStr)} mov ecx, eax shl eax, 16 or ecx, eax {All 4 Bytes = Last Character of SubStr} @@MainLoop: add edx, 4 cmp edx, esi ja @@Remainder {1 to 4 Positions Remaining} mov eax, [edx-4] {Check Next 4 Bytes of S} xor eax, ecx {Zero Byte at each Matching Position} lea ebx, [eax-$01010101] not eax and eax, ebx and eax, $80808080 {Set Byte to $80 at each Match Position else $00} jz @@MainLoop {Loop Until any Match on Last Character Found} bsf eax, eax {Find First Match Bit} shr eax, 3 {Byte Offset of First Match (0..3)} lea edx, [eax+edx-4] {Address of First Match on Last Character} @@Compare: inc edx cmp edi, -4 jle @@Large {Lenght(SubStr) >= 4} cmp edi, -1 je @@SetResult {Exit with Match if Lenght(SubStr) = 1} mov ax, [ebp+edi] {Last Char Matches - Compare First 2 Chars} cmp ax, [edx+edi] jne @@MainLoop {No Match on First 2 Characters} @@SetResult: {Full Match} lea eax, [edx+edi] {Calculate and Return Result} POP EDI {len SubSTR} pop edx SUB eax, edx {Subtract Start Position} ADD EDI,EAX {prochain depuis} MOV EDX,EDI pop ebp pop esi pop edi POP ECX MOV [ECX],EDX {vers depuis} pop ebx // ret JMP @@end @@NotFound: POP EDI pop edx {Dump Start Position} pop ebp pop esi pop edi @@InvalidInput: POP ECX MOV EAX,1 MOV [ECX],EAX {depuis mis à 1 par défaut} pop ebx xor eax, eax {No Match Found - Return 0} // ret JMP @@end @@Remainder: {Check Last 1 to 4 Characters} sub edx, 4 @@RemainderLoop: cmp cl, [edx] je @@Compare cmp edx, esi jae @@NotFound inc edx jmp @@RemainderLoop @@Large: mov eax, [ebp-4] {Compare Last 4 Characters} cmp eax, [edx-4] jne @@MainLoop {No Match on Last 4 Characters} mov ebx, edi @@CompareLoop: {Compare Remaining Characters} add ebx, 4 {Compare 4 Characters per Loop} jge @@SetResult {All Characters Matched} mov eax, [ebp+ebx-4] cmp eax, [edx+ebx-4] je @@CompareLoop {Match on Next 4 Characters} jmp @@MainLoop {No Match} @@END: end; {PosDJ}
Sauf qu'il donne des résultats 3 fois supérieurs à GetTickCount, ce n'est probablement pas des millisecondes :
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 303 caractères alétoires : Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 10 662 ms dont 6 995 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 10 580 ms dont 6 839 ms uniquement pour les appels à posEXD
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 25 juin 2015 à 17:28
Bonjour,
Essayez ce chrono, il est plus pécis:
Function MyGetTickCount: Int64; Var lpPerformanceCount, lpFrequency : Int64; Begin If Not QueryPerformanceCounter(lpPerformanceCount) Then lpPerformanceCount := GetTickCount Else Begin QueryPerformanceFrequency(lpFrequency); lpPerformanceCount := (lpPerformanceCount * 1000) Div lpFrequency End;
Réponse au message de Piette du 24 juin 2015 à 22:19
>> "L'astuce c'est la chance!
J'ai modifié PosEX en PosEXD avec la variable Depuis intégrée,
mais pas la constante jusqua afin de délimiter un champs, cela doit être plus
rapide que mon premier prog asm force brute, je vous le joins pour la compétition " :
Ok, si l'astuce est la chance y a rien à y piger, d'ailleurs à force de faire des tests de vitesse on découvre souvent des comportements surprenants des codes.
PosEXD est effectivement plus rapide que votre Pos_BMH du 20 juin et même un chouillia plus rapide que PosEx.
Voici les résultats de la compétition :
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 303 caractères alétoires : Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 604 ms dont 3 402 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 3 541 ms dont 3 228 ms uniquement pour les appels à posEXD
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 4 914 ms dont 4 695 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 4 540 ms dont 4 322 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 3 728 ms dont 3 382 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 5 335 ms dont 5 208 ms uniquement pour les appels à Pos_BMH
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 fois, Mis : 2 917 ms dont 2 711 ms uniquement pour les appels à BMHPascalNaif
Et voici un extrait du début du code de tests :
procedure TForm1.bCompetitionClick(Sender: TObject);
var Mot, Texte, Separ: string; i, LM, LT, Depuis, Jusqua, Po, Delta, OccMax, PoPrem, Occ: integer;
GTC1, GTC2, Mis, nbTours, Count: longWord; Ok: boolean; PoDW, DepartDW, DepuisDW: LongWord;
aStr: string;
ComptageStrict: boolean;
begin
Sablier;
RE.Clear;
Mot := StrAleatoireMajus(510);
Separ := StrAleatoireMinus(1020);
Texte := '***';
for i := 1 to 10 do Texte := Texte + Mot + Separ;
LM := length(Mot); LT := length(Texte);
Count := 0;
nbTours := 1000000;
aStr := Format('Pour %.0n - Recherches de Mot de %.0n caractères aléatoires dans Texte de %.0n caractères alétoires : ' + CompileAvec, [nbTours / 1, LM / 1, LT / 1]);
Trace(' ');
Trace(aStr);
Trace(' ');
<bold>// PosEx de Cirec 16 juin 2015</bold>
GTC1 := GetTickCount; Mis := 0;
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosEx(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosEx(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(Format('- Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n ' +
'ms uniquement pour les appels à %s', ['StrUtils.PosEx ASM version',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'StrUtils.PosEx']));
// Version Cirec avec InitFastSkip(Mot);
<bold>// PosExD de Piette :</bold>
Trace('');
GTC1 := GetTickCount; Mis := 0;
for i := 1 to nbTours do begin
D := 1; Count := 0;
GTC2 := GetTickCount;
Mis := Mis + (GetTickCount - GTC2);
Po := posEXD(Mot, Texte, D);
while Po > 0 do begin
inc(Count);
GTC2 := GetTickCount;
Po := posEXD(Mot, Texte, D);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(Format('- Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n ' +
'ms uniquement pour les appels à %s', ['posEXD ASM de Piette',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'posEXD']));
end;
Bonjour,
L'astuce c'est la chance!
J'ai modifié PosEX en PosEXD avec la variable Depuis intégrée,
mais pasla constante jusqua afin de délimiter un champs, cela doit être plus
rapide que mon premier prog asm force brute, je vous le joins pour la compétition
program test_posEXD;
{$APPTYPE CONSOLE}
uses
sysutils;
function PosExD(const SubStr, S: string; var Depuis: Integer): Integer; Register;
asm //modification de PosEX
push ebx
cmp eax, 1
sbb ebx, ebx {-1 if SubStr = '' else 0}
sub edx, 1 {-1 if S = ''}
sbb ebx, 0 {Negative if S = '' or SubStr = '' else 0}
PUSH ECX {ptr Depuis}
MOV ECX,[ECX]
dec ecx {Offset - 1}
or ebx, ecx {Negative if S = '' or SubStr = '' or Offset < 1}
jl @@InvalidInput
push edi
push esi
push ebp
push edx
mov edi, [eax-4] {Length(SubStr)}
PUSH EDI
mov esi, [edx-3] {Length(S)}
add ecx, edi
cmp ecx, esi
jg @@NotFound {Offset to High for a Match}
test edi, edi
jz @@NotFound {Length(SubStr = 0)}
lea ebp, [eax+edi] {Last Character Position in SubStr + 1}
add esi, edx {Last Character Position in S}
// movzx eax, [ebp-1] {Last Character of SubStr ne compile pas en D5}
MOV AL,[EBP-1] {remplace movzx}
AND EAX,$000000FF {remplace movzx}
add edx, ecx {Search Start Position in S for Last Character}
mov ah, al
neg edi {-Length(SubStr)}
mov ecx, eax
shl eax, 16
or ecx, eax {All 4 Bytes = Last Character of SubStr}
@@MainLoop:
add edx, 4
cmp edx, esi
ja @@Remainder {1 to 4 Positions Remaining}
mov eax, [edx-4] {Check Next 4 Bytes of S}
xor eax, ecx {Zero Byte at each Matching Position}
lea ebx, [eax-$01010101]
not eax
and eax, ebx
and eax, $80808080 {Set Byte to $80 at each Match Position else $00}
jz @@MainLoop {Loop Until any Match on Last Character Found}
bsf eax, eax {Find First Match Bit}
shr eax, 3 {Byte Offset of First Match (0..3)}
lea edx, [eax+edx-4] {Address of First Match on Last Character}
@@Compare:
inc edx
cmp edi, -4
jle @@Large {Lenght(SubStr) >= 4}
cmp edi, -1
je @@SetResult {Exit with Match if Lenght(SubStr) = 1}
mov ax, [ebp+edi] {Last Char Matches - Compare First 2 Chars}
cmp ax, [edx+edi]
jne @@MainLoop {No Match on First 2 Characters}
@@SetResult: {Full Match}
lea eax, [edx+edi] {Calculate and Return Result}
POP EDI {len SubSTR}
pop edx
SUB eax, edx {Subtract Start Position}
ADD EDI,EAX {prochain depuis}
MOV EDX,EDI
pop ebp
pop esi
pop edi
POP ECX
MOV [ECX],EDX {vers depuis}
pop ebx
ret
@@NotFound:
POP EDI
pop edx {Dump Start Position}
pop ebp
pop esi
pop edi
@@InvalidInput:
POP ECX
MOV EAX,1
MOV [ECX],EAX {depuis mis à 1 par défaut}
pop ebx
xor eax, eax {No Match Found - Return 0}
ret
@@Remainder: {Check Last 1 to 4 Characters}
sub edx, 4
@@RemainderLoop:
cmp cl, [edx]
je @@Compare
cmp edx, esi
jae @@NotFound
inc edx
jmp @@RemainderLoop
@@Large:
mov eax, [ebp-4] {Compare Last 4 Characters}
cmp eax, [edx-4]
jne @@MainLoop {No Match on Last 4 Characters}
mov ebx, edi
@@CompareLoop: {Compare Remaining Characters}
add ebx, 4 {Compare 4 Characters per Loop}
jge @@SetResult {All Characters Matched}
mov eax, [ebp+ebx-4]
cmp eax, [edx+ebx-4]
je @@CompareLoop {Match on Next 4 Characters}
jmp @@MainLoop {No Match}
end; {PosExD}
var Mot,Texte : string;
D,N,R: integer;
begin
// Insérer le code utilisateur ici
Mot := '3456789';
Texte :='012345678901234567890123456789012345678901234567890123456789123';
D:=1; N:=0;
for R := 1 to 10000 do
while posEXD(mot,texte,D) <> 0 do inc(N);
writeln(N,' trouvailles');
readln;
end.
Pour répondre plus sérieusement à votre question, je ne sais pas, il faut décortiquer les autres progs.
Une technique répandue des processeurs est appelée exécution spéculative. Cette technique utilise les possibilités de traitement en parallèle du processeur pour exécuter plusieurs instructions à la fois dont spéculer sur les branchements et il est très difficile pour un amateur
comme moi de savoir quelle instruction serait la plus rapide, c'est pour cela que je parlai de chance.
J'ai testé pos(1° version) et posEXD
pour 10000000 de 6 tests
posEXD = 691 ms (pas de gestion de jusqua)
POS = 872 ms (dont une gestion de jusqua)
soit posEXD est 3 nanosecondes plus rapide que POS pour une recherche.
Réponse au message de Piette du 24 juin 2015 à 14:28
>> "Poséx utilise la force brute / 4.Donc c'est plus rapide pour substr/4 " :
Oui, j'ai remarqué.
Tenez si ça vous intéresse : Comparatif des durées d'exécution des diverses SkipTables :
Pour 10 000 000 Initialisations de chaque SkipTable :
- Avec InitSkip(Mot) de KR85 : Mis : 421 ms
- Avec InitFastSkip(Mot, TRUE) de Cirec : Mis : 624 ms
- Avec InitFastSkip(Mot, FALSE) de Cirec : Mis : 640 ms
- Avec initBMH_sauts(Mot) de Piette : Mis : 250 ms : Chapeau !!! - Avec InitSkip22(Mot, FALSE) de GG: Mis : 826 ms
- Avec InitSkip22(Mot, TRUE) de GG: Mis : 827 ms
Mais comme on fait appel à elles qu'une seule et unique fois avant les appels répétitifs au routines de recherche ces différences ne sont pas trop handicapantes.
C'est quoi l'astuce qui fait la vélocité de votre initBMH_sauts ?
Bonjour,
Poséx utilise la force brute / 4.
Donc c'est plus rapide pour substr/4
Un peu moins pour substr/2
Et moins pour substr impair
Et moins pour les mots longs.
Bons tests
A) Mon message du 21 juin 2015 à 11:13 concernait les résultats obtenus en corrigeant le code d'utilisation de BMHPascalNaifEx exactement suivant tes instructions et ça a bien corrigé le nombre d'occurrences trouvées avec elle, donc ce problème est réglé.
Par contre je viens de me rendre compte qu'il y a une erreur dans mon message du 21 juin 2015 à 11:13 où j'ai écrit :
"Si on cherche les occurrences de u présent 3 fois dans 0123une456789012345678une90123456une789012345678901234567890123456789123
Pour nb-Recherches = 1 :
- Avec BMHPascalNaif => Trouvé : 36 fois, Mis : 0 ms dont 0 ms uniquement pour les appels à BMHPascalNaif " :
J'y ai oublié le Ex et ça ne concerne donc que BMHPascalNaifEx et pas tes autres routines.
Par contre si on y cherche un ou une alors BMHPascalNaifEx trouve correctement les 3 occurrences présentes.
B) J'ai aussi remarqué autre chose en comparant PosEX à ma BMHPascalNaif en faisant varier la longueur du Mot de 10 à N pour déterminer la longueur minimale pour laquelle les deux se valent car le Boyer-Moore vu son principe est d'autant plus rapide que la longueur du Mot est grande et que le mot est absent dans les Textes dans lesquels on le cherche car c'est dans ce cas qu'il avance par sauts de longueur égale à celle du Mot.
Résultats :
Pour 1 000 000 de Recherches de Mot de LM caractères aléatoires présent 15 fois dans Texte de 15 300 caractères aléatoires :
GRNWPWMTKZ < LM = 10 dans LT = 15300
- Avec PosEx => Trouvé : 15 fois, Mis : 3 026 ms
- Avec BMHPascalNaif => Trouvé : 15 fois, Mis : 4 977 ms
.... Suite de la boucle
GDRNBZOQEMBSFCBGKR < = LM 18 dans LT = 15300
- Avec PosEx => Trouvé : 15 fois, Mis : 3 057 ms
- Avec BMHPascalNaif => Trouvé : 15 fois, Mis : 2 964 ms
... EXIT boucle lorsque LM = length(Mot) >= 18
Donc pour optimiser la vitesse on peut faire appel à PosEx si LM < 18 et à BMHPascalNaif si LM >= 18
(temps d'exécution et LM valables pour Intel Core i7 - 2700 K à 3, 5 GHz)
Cordialement, et à +.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 23 juin 2015 à 18:00
re,
j'ai refait tous les testes avec toutes les fonctions que j'ai et je n'ai aucuns des problèmes que tu décris !!!
pour SelStart je suis à Po -1 ce qui est tout à fait normal si l'on considère la description dans l'aide de Delphi:
Description
Utilisez SelStart pour déterminer la position du premier caractère sélectionné, où 0 représente le premier caractère....
soit tu as mal recopié mes codes (bug durant le copier coller) ou tu utilises tes propres modifications ou je ne sais quoi d'autre .... mais chez moi tout fonctionne comme il se doit !
regardes ton code, compares le au miens et si tu ne trouves pas de différences je te ferai une nouvelle copie pour tester ;)
Réponse aux messages de Cirec du 20 juin 2015 à 18:11 et du 20 juin 2015 à 19:23
>> "Teste déjà ça pour voir si ça corrige le problème : " OK, merci ça corrige bien le problème du nombre d'occurrences trouvées, mais il reste un inconvénient mineur qui n'apparaît que lorsqu'on se sert de la position pour colorier les Mots trouvés dans un RichEdit : les positions sont décalées de 2 mais on peut s'en sortir avec un SelStart := Po - 2;
La correction réduit également le temps d'exécution puisque avant correction pour afficher 27 occurrences au lieu de 10 elle recherchait visiblement 3 fois 9 occurrences :
- Avec BMHPascalNaif => Trouvé : 10 fois, Mis : 2 964 ms dont 2 794 ms uniquement pour les appels à BMHPascalNaif
Avec BMHPascalNaifEx => Trouvé : 10 fois, Mis : 3 510 ms dont 3 199 ms uniquement pour les appels à BMHPascalNaifEx
En plus de ceci sans vouloir t'agacer j'ai encore trouvé une autre faille :
Si on cherche les occurrences de u présent 3 fois dans 0123une456789012345678une90123456une789012345678901234567890123456789123
Pour nb-Recherches = 1 :
- Avec BMHPascalNaif => Trouvé : 36 fois, Mis : 0 ms dont 0 ms uniquement pour les appels à BMHPascalNaif
J'avais le même problème lorsque j'ai corrigé ma version de BMHPascalNaif et je me suis dit que si quelqu'un cherchait le nombre de C, T, A ou G dans une séquence d'A.D.N ce serait impossible du coup j'ai remplacé le 2ième While par un Repeat.
Cordialement, et à +.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 20 juin 2015 à 19:23
j'ai réussi à reproduire l'erreur grace à ton code ce qui me conforte à penser que le problème est résolu.
ce qui m'amène au problème suivant dans ton code :
pour passer à l'occurrence suivante il faut faire :
Depuis := Po + LM; Po = Position précédente LM = Longueur du Mot !
toi tu fais
Depuis := Po + LM + 1; erreur que j'ai véhiculé en recopiant sans regarder le code :(
soit ta fonction renvoie une mauvaise position ou ton Depuis est faussé
prenons l'hypothèse d'un Mot de 4 caractère dont la première occurrence se trouve au tout début du texte :
on a LM = 4
et Po = 1
la recherche suivante doit se faire à partir de la position 5 ... Donc de LM=4 + Po=1 = 5
avec ton code elle se fait à partir de 5 mais dans ce cas c'est la position de l'occurrence qui est fausse
on a LM=4 + Po=0 + 1 = 5
Pour corriger tout cela il te faut ajouter 1 à la valeur de sortie de la fonction (mais que pour ta fonction):
if im = 0 then begin
Result := true; Depuis := it + 1; // <-------------- ICI
EXIT; // Occurrence Trouvée
end;
ça n'a aucune incidence sur le teste mais sur l'exactitude de la position renvoyée par la fonction
et retirer le + 1 au passage à l'occurrence suivante et ceci est valable pour toutes les fonctions testées
@+ Cirec
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 20 juin 2015 à 18:11
tu t'es un peu mélangé les pinceaux ^^ ;)
remplace déjà ton code de teste par celui-ci:
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := BMHPascalNaifEx(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM; // modif ???
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := BMHPascalNaifEx(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['BMHPascalNaifEx',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'BMHPascalNaifEx']));
J'ai fait des tests comparatifs de vitesse avec votre Pos_BMH du 20 juin en ASM,
les résultats des tests figurent dans mon message du 20 juin 2015 à 15:46 intitulé "Réponse au message de Cirec - 20 juin 2015 à 12:54"
Réponse au message de Cirec - 20 juin 2015 à 12:54
>> "j'ai retiré tout ce qui me semblait être inutile et redondant et le résultat s'en fait ressentir, surtout
sur des recherches de mots long, c'est la plus véloce ... jusqu'à 50% plus rapide que l'original !!" :
Je viens de tester BMHPascalNaifEx pour comparer aux autres mais j'ai des résultats bizarres :
Avec paramètres de recherche :
Mot := StrAleatoireMajus(510); Separ := StrAleatoireMinus(1020); Texte := ''; for i := 1 to 10 do Texte := Texte + Mot + Separ; LM := length(Mot); LT := length(Texte); nbTours := 1000000
Résultats :
Pour 1 000 000 - Recherches de Mot de 510 caractères dans Texte de 15 300 caractères: Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 385 ms dont 3 184 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 7 051 ms dont 6 861 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 10 fois, Mis : 7 129 ms dont 6 927 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 4 821 ms dont 4 634 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 4 602 ms dont 4 340 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 10 fois, Mis : 5 928 ms dont 5 713 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec BMHPascalNaif => Trouvé : 10 fois, Mis : 2 980 ms dont 2 810 ms uniquement pour les appels à BMHPascalNaif
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 5 132 ms dont 4 914 ms uniquement pour les appels à Pos_BMH
- Avec BMHPascalNaifEx => Trouvé : 27 fois, Mis : 9 968 ms dont 9 313 ms uniquement pour les appels à BMHPascalNaifEx
27 fois ça fait beaucoup trop!
Mais je l'ai peut-être mal utilisée donc voici le bout de code du test qui concerne BMHPascalNaifEx :
GTC1 := GetTickCount; Mis := 0; InitSkip22(Mot, false); for i := 1 to nbTours do begin Count := 0; Depuis := 1; GTC2 := GetTickCount; Po := BMHPascalNaifEx(Mot, Texte, Depuis); Mis := Mis + GetTickCount - GTC2; while Po > 0 do begin inc(Count); Depuis := Depuis + LM + 1; if Depuis >= LT then break; GTC2 := GetTickCount; Po := BMHPascalNaifEx(Mot, Texte, Depuis); Mis := Mis + GetTickCount - GTC2; end; end; Trace(Format('- Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n ' + 'ms uniquement pour les appels à %s', ['BMHPascalNaifEx', Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'BMHPascalNaifEx']));
Cela fait un moment que cherche la cause de l'anomalie sans la trouver...
Par contre, au passage, on remarque parmi les résultats ceux de Pos_BMH en ASM de Piette avec ses 5 132 ms elle n'est pas plus rapide que PosEx.
Réponse au message de Cirec - 20 juin 2015 à 12:32
>> "Bon c'est un peu le bordel ces messages qui s'intercalent entre les réponses !!" :
Oui, c'est agaçant, et en plus on ne voit plus les premiers messages de la discussion, et puis ce qui manque cruellement c'est qu'on n'est plus prévenu par mail de l'arrivée d'une nouvelle réponse ou question.
>> "voici la correction du code BMHPascalNaif qui fonctionne et trouve toutes les occurences " :
Oups je viens aussi de mon coté de la corriger comme suit :
function BMHPascalNaif(const Mot, Texte: AnsiString; var Depuis: Integer): boolean; var rm, im, it, ik, LM, LT: integer; begin Result := false; LM := Length(Mot); LT := length(Texte); if (LM = 0) or (LT = 0) then EXIT; if (Depuis < 0) then Depuis := 0; ik := Depuis + LM; while (ik <= LT) do begin it := ik; im := LM; rm := LM - 1; if (Texte[it] = Mot[im]) and (Texte[it - rm] = Mot[1]) then begin repeat Dec(im); Dec(it); until (im = 0) or (Texte[it] <> Mot[im]); if im = 0 then begin Result := true; Depuis := it; EXIT; // Occurrence Trouvée end; end; Inc(ik, skip22[Texte[ik]]); end; Result := false; Depuis := 0; end;
et elle trouve aussi toutes les occurrences
>> "voilà tout est rentré dans l'ordre sauf pour la vitesse ... elle reste bonne dernière :"
Bizarre car chez moi elle arrive en tête avec les paramètres de recherche suivants :
Mot := StrAleatoireMajus(510); Separ := StrAleatoireMinus(1020); Texte := ''; for i := 1 to 10 do Texte := Texte + Mot + Separ; LM := length(Mot); LT := length(Texte); nbTours := 1000000;
Pour 1 000 000 - Recherches de Mot de 510 caractères dans Texte de 15 300 caractères: Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 525 ms dont 3 372 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 4 758 ms dont 4 571 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 10 fois, Mis : 7 426 ms dont 7 315 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 4 290 ms dont 4 010 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 4 602 ms dont 4 414 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 10 fois, Mis : 6 115 ms dont 5 831 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec BMHPascalNaif => Trouvé : 10 fois, Mis : 2 996 ms dont 2 728 ms uniquement pour les appels à BMHPascalNaif
Et voici le code de StrAleatoireMinus et Majus pour la création des paramètres de recherche aléatoires :
function StrAleatoireMinus(Len: LongWord): AnsiString; var i: longWord; R: Integer; begin SetLength(Result, Len); for i := 1 to Len do begin R := random(123 - 97); R := R + 97; Result[i] := Chr(R); end; end;
function StrAleatoireMajus(Len: LongWord): AnsiString; var i: longWord; R: Integer; begin SetLength(Result, Len); for i := 1 to Len do begin R := random(91 - 65); R := R + 65; Result[i] := Chr(R); end;
Bon, sur ce je vais tester le code de Piette.
Cordialement, et à +.
end;
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 20 juin 2015 à 12:54
Cette version devient une tuerie chez moi !!!
function BMHPascalNaifEx(const Mot, Texte: string; const Depuis: Integer = 1): Integer;
// Modifié par Cirec Pour un gain de temps de ~50% par rapport à l'original BMHPascalNaif
var im, it, ik, LM, LT: integer;
begin
Result := 0; LM := Length(Mot); LT := length(Texte);
if (LM = 0) or (LT = 0) then EXIT;
//---------------------------------------------------------------
ik := Depuis + LM - 1;
while (ik <= LT) do begin
it := ik;
im := LM;
if (Texte[it] = Mot[im]) and (Texte[it - LM + 1] = Mot[1]) then // < Pochoir coulissant à 2 trous
while (im > 0) and (Texte[it] = Mot[im]) do begin
Dec(im);
Dec(it);
end;
if im = 0 then
begin
Result := it+1;
EXIT; // Occurrence Trouvée
end;
Inc(ik, skip2[Texte[ik]]);
end;
Result := 0;
end;
j'ai retiré tout ce qui me semblait être inutile et redondant et le résultat s'en fait ressentir, surtout
sur des recherches de mots long, c'est la plus véloce ... jusqu'à 50% plus rapide que l'original !!
@+ Cirec
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 20 juin 2015 à 12:32
Bon c'est un peu le bordel ces messages qui s'intercalent entre les réponses !!
du coup je poste ma réponse à la suite ;)
voici la correction du code BMHPascalNaif qui fonctionne et trouve toutes les occurences ;)
function BMHPascalNaif(const Mot, Texte: AnsiString; var Depuis: Integer): Integer;
var rm, im, it, ik, LM, LT: integer;
begin
Result := 0; LM := Length(Mot); LT := length(Texte);
if (LM = 0) or (LT = 0) then EXIT;
if (Depuis < 1) then Depuis := 1;
//---------------------------------------------------------------
ik := Depuis + LM - 1;
while (ik <= LT) do begin
it := ik;
im := LM; rm := LM - 1;
if (Texte[it] = Mot[im]) and (Texte[it - rm] = Mot[1]) then // < Pochoir coulissant à 2 trous
while (im > 0) and (Texte[it] = Mot[im]) do begin // <--- ici Modif Cirec
Dec(im);
Dec(it); dec(rm);
end;
if rm < 0 then begin
Result := it + 1; Depuis := it + 1; EXIT; // Occurrence Trouvée// <--- ici Modif Cirec
end else begin
Inc(ik, skip2[Texte[ik]]);
end;
end;
Result := 0; Depuis := 1;
end;
il y avait 2 erreurs
- La correction dans le code ci-dessus
- Une erreur de ma part ... j'essayai de faire une comparaison avec une fonction case sensitive et une table de sauts non case sensitive !!!!
voilà tout est rentré dans l'ordre sauf pour la vitesse ... elle reste bonne dernière :(
Réponse au message de Cirec - 19 juin 2015 à 13:07
2eme point "... ça t'aurais permis de découvrir ou de constater des erreurs dans le code !!! ... ceci est aussi valable pour la dernière version BMHPascalNaif " :
OK, merci je vais rectifier le code.
4ème point " ...et tu as utilisé, pour tes testes, la version Byte "array[Byte] of Byte" alors que la version Integer "array[Byte] of Integer" est plus rapide "
:
En fait la version qui était utilisée par défaut était bien la version Integer "array[Byte] of Integer et l'erreur ne provenait que de l'affichage car je n'ai utilisé que ton *.pas en tant qu'unit supplémentaire utilisée à partir de la Form principale de mon application de tests (ça m'évite d'avoir à naviguer entre deux applications), et je n'avais pas désactivé la ligne qui contient la compilation conditionnelle. Mais ce problème d'affichage est maintenant réglé.
5ème point " ... sur le fond tu as raison mais sur la forme je ne suis pas d'accord d'une fonction de recherche j'attends quelle me permette de faire ma recherche ... case sensitive ou non, avec ou sans accents" :
Entièrement d'accord car les préférences personnelles ça se discute pas.
Pour ma part j'ai préféré simplifier car j'utilise la constante MNA essentiellement pour gommer les erreurs de frappe gommables vu que les erreurs d'accentuation sont très fréquentes et qu'on a l'habitude d'écrire des phrases en minuscules qui commencent généralement par une majuscule.
Et en plus ça réduit la quantité de tests à effectuer lors des recherches de gains de vitesse.
réponse à mon message suivant: "....chez moi que ce soit sur le vieux PC ou sur I7 la BMHPascalNaif reste bonne dernière !!!!!!" :
Bizarre, Je pense que ça vaudrait le coup de se mettre d'accord sur un ou deux protocoles de tests de vitesse simples, car c'est surprenant qu'elle soit la première chez moi et la dernière chez toi.
"... Mais le plus important c'est qu'elle n'est pas juste dans ses résultats !
alors que toutes les fonctions donnent un résultat de 100 occurrences trouvées sauf les non case sensitive qui elles en trouvent 104 ce qui est juste ;)
la BMHPascalNaif n'en trouve que 80 !!! " :
Ceci c'est bien plus fâcheux je vais chercher la cause de cette erreur et je reviens.
unit POaSm;
interface
{ Les fonction Pos_BMH recherche toutes les sous-chaînes, Substr, à l'intérieur
d'un champ délimité d'une chaîne S.
Substr et S sont des expressions de type chaîne.
Pos_BMH recherche Substr à l'intérieur de S et renvoie une valeur entière
correspondant à l'indice des premiers caractères des Substr à l'intérieur de S.
Pos_BMH fait la distinction majuscules/minuscules.
Si Substr est introuvable, Pos_BMH renvoie zéro.
Pos_BMH_txt ne fait pas la distinction entre majuscules/minuscules et utilise
un pilote local, la conversion MAJ/min fait appel au pilote de langue Windows
actuellement installé.
la bascule Differencier_MAJ_min permet de changer ce comportement.
Il reste possible de modifier ce comportement dans Fab_arPiloc, par exemple
les différence de caractères accentués du e sont ignorés ici.
SubSTR = recherche STR = étendue de recherche TS = table de sauts
Depuis -> STR[Depuis]=début de recherche jusqua -> STR[jusqua]=fin de recherche
Depuis > 0 <= Length(STR)-Length(SubSTR)+1
Jusqua (optionnel) < length(STR) >= Length(SubSTR)
Jusqua - Depuis - Length(SubSTR) + 1 => 0
Result = index de Position de SubSTR dans STR à partir de STR[1]
Si Result = 0 alors SubSTR n'est pas (plus) dans STR
La relance de la recherche tant que Result <> 0 permet de trouver toutes les
Occurrences de SubSTR dans STR
-1° fabriquer la table de sauts avec InitBMH_sauts
-2° Rechercher avec la table de sauts avec Pos_BMH
---------------Recherches Binaires---------------------------------------------}
Type TBMH_sauts = array[char] of Byte; //table de sauts
TreTxt = Packed Record
SubStr : string;
TS : TBMH_sauts;
end;
//la table de sauts est mise dans les paramétres (le plus rapide)
procedure initBMH_sauts(Const SubStr : string; var TS : TBMH_sauts); register; overload;
function Pos_BMH(Const SubStr,Str : string; Const TS : TBMH_sauts;
var Depuis : integer; jusqua : Integer = 0):integer; register; overload;
//La table de sauts est fournie par défaut
procedure initBMH_sauts(Const SubStr : string); register; overload;
function Pos_BMH(Const SubStr,Str : string; var Depuis : integer;
jusqua : Integer = 0):integer; register; overload;
//La table de sauts est recalculée à chaque appel, il n'y a pas d'initialisation
function PosDJ (Const SubStr,Str : string;
var Depuis : integer; jusqua : Integer = 0):integer; register;
{-------------------Recherche avec pilote locale-------------------------------}
procedure initPiLoc (Const SubSTR : string; var rePiLoc : TreTxt); Register; overload;
function Pos_BMH_txt(Const TPL : TreTxt; Const Str : string; var Depuis : integer;
jusqua : Integer = 0):integer; register; overload;
procedure initPiLoc (Const SubSTR : string); Register; overload;
function Pos_BMH_txt(Const Str : string; var Depuis : integer;
jusqua : Integer = 0):integer; register; overload;
function PosDJ_txt (Const SubStr,Str : string;
var Depuis : integer; jusqua : Integer = 0):integer; register;
procedure Differencier_MAJ_min(OK : boolean);
implementation
uses SysUtils;
Type TarPiLoc = array[char] of char;
//++Pilote et Tables par défaut+++++++++++++++++++++++++++++++++++++++++++++++++
var arPiLoc : TarPiLoc; //Pilote Local
BMH_sauts : TBMH_sauts; //table par défaut
Pour_Pos : TBMH_sauts; //table par défaut pour PosDJ
BMH_txt : TreTxt;
Pour_Pos_txt : TreTxt;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//-----------------------pas d'appel direct de cette procedure-----------------
procedure __initBMH_sauts{(Const SubStr : string; var TT : TBMH_sauts)}; register;
asm // PUSH EBP MOV EBP,ESP
AND EAX,EAX //subSTR vide ?
JNZ @xx
MOV EAX,$01010101 //la table BMH devient force brute
MOV ECX,type TBMH_sauts
SHR ECX,2 //ECX/4
@x: //charge table de 1
MOV [EDX],EAX
ADD EDX,4
DEC ECX
JNZ @x
JMP @sortie //vers sortie
@xx:
PUSH EDI
MOV EDI,EDX //EDI ptr(TT)
push esi
mov esi,eax // ESI pointe SubStr
mov eax,[esi]-4 //eax = len(substr)
PUSH EAX
AND AH,AH
JZ @xxx
XOR AL,AL //length(SubSTR) > 255 donc 255
DEC AL
@xxx:
mov ah,al
mov ecx,eax
bswap eax
mov ax,cx
MOV ECX,type TBMH_sauts
SHR ECX,2 //ECX/4
PUSH EDI
CLD //eteind direction donc incrémentation
REP STOSD // EAX->[EDI] EDI+4 ECX+1 ECX=0=fin
POP EDI
POP ECX // len subSTR
xor edx,edx
@R2:
MOV EAX,ECX
AND AH,AH
JZ @y
XOR AL,AL //length(SubSTR) > 255 donc 255
DEC AL
@y:
mov dl,byte ptr[esi]
mov byte ptr[EDI]+edx,al
INC ESI
dec ecx
jnz @R2
POP ESI
POP EDI
@sortie:
end; //POP EBP RET N
//end--------------------pas d'appel direct de cette procedure-----------------
function POS_BMH(Const SubStr,Str : string; Const TS : TBMH_sauts;
var Depuis : integer; jusqua : Integer = 0):integer; register; overload;
var lenSub,lenStr,k : longWord;
{EBP+12=ptr Depuis EBP+8 = Jusqua
la partie algorithme de recherche est empreintée à KR85
http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=82390
}
asm // PUSH EBP MOV EBP,ESP
push ebx
MOV EBX,ECX //EBX ptr table
push edi
mov edi,edx // edi pointe Str
push esi
mov esi,eax // esi pointe SubStr
AND EAX,EDX
JZ @finNulle; //SubSTR ou Str vide
mov eax,[EBP+12]
mov eax,[eax] //depuis
dec eax
mov edx,[edi-4] // length total de STR
MOV ECX,EDX
add edi,eax //edi = Str[depuis]
sub edx,eax
MOV EAX,[EBP+8] //jusqua
AND EAX,EAX
JZ @z
CMP EAX,ECX //jusqua > len(STR)
JA @z //non pris en compte
SUB ECX,EAX
SUB EDX,ECX
@z:
mov lenStr,edx // LenStr = Str[Depuis]..Str[jusqua]
mov eax,[esi]-4
mov lenSub,eax // LenSub = length(SubStr)
mov k,eax
// 2 - Algorithme de recherche (KR85)
@whilek:
cmp eax,lenStr // eax : k > lenStr ?
jg @FinNulle // oui fin nulle
mov ecx,eax // ecx : i = k
mov edx,lenSub // edx : j = lensub
@Verif:
dec ecx // dec(i)
dec edx // dec(j)
jl @FinBonne // si < 0 occurence trouvée
mov al,byte ptr[edi]+ecx // al = char STR
//--------CALL UpCase pour UpperCase(SubSTR);
mov ah,byte ptr[esi]+edx
cmp ah,al
je @Verif // si S[i]=Sub[j] continuer
xor eax,eax // si non nouveau décalage
mov eax,k
mov al,byte ptr[edi]+eax
//--------CALL UpCase pour UpperCase(SubSTR);
AND EAX,$000000FF //filtre si k > 256
mov al,byte ptr[ebx]+eax
add eax,k
mov k,eax
jmp @whilek
@FinNulle:
xor eax,eax // retour pos 0
MOV EBX,1
MOV EDX,[EBP+12] //initialise Depuis à 1
jmp @retour
@FinBonne:
mov eax,ecx
mov edx,[ebp+12] // ptr depuis
inc eax // retour avec pos(SubStr)
add eax,[edx]
MOV EBX,EAX
ADD EBX,LenSub
@retour:
MOV [EDX],EBX //vers Depuis char suivant
pop esi
pop edi
pop ebx
end; //POP EBP RET N
//------------------------Recherches sans différencier MAJ et min---------------
function POS_BMH_txt(Const TPL : TreTxt{SubStr}; Const Str : string; {Const TS : TBMH_sauts;}
var Depuis : integer; jusqua : Integer = 0):integer; register; overload;
var lenSub,lenStr,k,sDepuis : longWord;
{EAX=TPL EDX=Str ECX=ptr(Depuis) EBP+8 = Jusqua
la partie algorithme de recherche est empreintée à KR85
http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=82390
la colonne de droite est la copie de POS_BMH pour maitenance de POS_BMHtxt
}
asm // PUSH EBP MOV EBP,ESP
MOV sDepuis,ECX
LEA ECX,[EAX].TreTxt.TS
LEA EAX,[EAX].TreTxt.SubSTR
MOV EAX,[EAX] //SubSTR[1]
push ebx
MOV EBX,ECX //EBX ptr table
push edi
mov edi,edx // edi pointe Str
push esi
mov esi,eax // esi pointe SubStr
AND EAX,EDX
JZ @finNulle; //SubSTR ou Str vide
// mov eax,[EBP+12]
MOV EAX,sDepuis
mov eax,[eax] //depuis
dec eax
mov edx,[edi-4] // length total de STR
MOV ECX,EDX
add edi,eax //edi = Str[depuis]
sub edx,eax
MOV EAX,[EBP+8] //jusqua
AND EAX,EAX
JZ @z
CMP EAX,ECX //jusqua > len(STR)
JA @z //non pris en compte
SUB ECX,EAX
SUB EDX,ECX
@z:
mov lenStr,edx // LenStr = Str[Depuis]..Str[jusqua]
mov eax,[esi]-4
mov lenSub,eax // LenSub = length(SubStr)
mov k,eax
// 2 - Algorithme de recherche (KR85)
@whilek:
cmp eax,lenStr // eax : k > lenStr ?
jg @FinNulle // oui fin nulle
mov ecx,eax // ecx : i = k
mov edx,lenSub // edx : j = lensub
@Verif:
dec ecx // dec(i)
dec edx // dec(j)
jl @FinBonne // si < 0 occurence trouvée
XOR EAX,EAX
mov al,byte ptr[edi]+ecx // al = char STR
MOV AL,byte ptr[arPiloc]+EAX //calcul adresse avant chargement de AL
mov ah,byte ptr[esi]+edx
cmp ah,al
je @Verif // si S[i]=Sub[j] continuer
xor eax,eax // si non nouveau décalage
mov eax,k
mov al,byte ptr[edi]+eax
AND EAX,$000000FF
MOV AL,byte ptr[arPiloc]+EAX //calcul adresse avant chargement de AL
mov al,byte ptr[ebx]+eax
add eax,k
mov k,eax
jmp @whilek
@FinNulle:
xor eax,eax // retour pos 0
MOV EBX,1
// MOV EDX,[EBP+12] //initialise Depuis à 1
MOV EDX,sDepuis
jmp @retour
@FinBonne:
mov eax,ecx
// mov edx,[ebp+12] // ptr depuis
MOV EDX,sDepuis
inc eax // retour avec pos(SubStr)
add eax,[edx]
MOV EBX,EAX
ADD EBX,LenSub
@retour:
MOV [EDX],EBX //vers Depuis char suivant
pop esi
pop edi
pop ebx
end; //POP EBP RET N
procedure PilocUpperCase (var SubSTR : string); Register;
//PilocUpperCase convertit en majuscules les caractères de la chaîne spécifiée.
//La conversion fait appel au pilote local;
asm // PUSH EBP MOV EBP,ESP
MOV EDX,[EAX] //EAX ptr(table des adresses string)
AND EDX,EDX // EDX = ptr(SubSTR)
JZ @Kenavo //SubSTR vide
MOV ECX,[EDX-4] //length
PUSH ESI
LEA ESI,[arPiLoc] //ptr(pilote local)
XOR EAX,EAX
@Rodell:
MOV AL,Byte ptr[EDX]
MOV AL,Byte ptr[ESI]+EAX //arPiloc[ord(SubSTR[EDX])]
MOV Byte ptr[EDX],AL //recopie dans SubSTR
INC EDX
DEC ECX
JNZ @Rodell
POP ESI
@Kenavo:
end; //POP EBP RET N
//------------------------------------------------------------------------------
procedure initPiLoc (Const SubSTR : string; var rePiLoc : TreTxt); Register; overload;
begin
rePiLoc.SubStr:=SubSTR; PilocUpperCase(rePiLoc.SubSTR);
initBMH_sauts(rePiLoc.subSTR,rePiloc.TS);
end;
procedure initPiLoc (Const SubSTR : string); Register; overload;
begin
BMH_txt.SubStr:=SubSTR; PilocUpperCase(BMH_txt.SubSTR);
initBMH_sauts(BMH_txt.subSTR,BMH_txt.TS);
end;
function POS_BMH_txt(Const Str : string; var Depuis : integer;
jusqua : Integer = 0):integer; register; overload;
begin
Result:=POS_BMH_txt(BMH_txt,Str,Depuis,jusqua);
end;
function PosDJ_txt (Const SubStr,Str : string;
var Depuis : integer; jusqua : Integer = 0):integer; register;
begin
initPiloc(SubSTR,Pour_Pos_txt);
Result:=POS_BMH_txt(Pour_Pos_txt,Str,Depuis,jusqua);
end;
//------------------------------------------------------------------------------
procedure initBMH_sauts(Const SubStr : string; var TS : TBMH_sauts); register; overload;
begin
__initBMH_sauts;
end;
procedure initBMH_sauts(Const SubStr : string); register; overload;
asm
LEA EDX,BMH_sauts
CALL __initBMH_sauts;
end;
function Pos_BMH(Const SubStr,Str : string;
var Depuis : integer; jusqua : Integer = 0):integer; register; overload;
begin
Result:=Pos_BMH(SubSTR,STR,BMH_sauts,Depuis,jusqua);
end;
function PosDJ (Const SubStr,Str : string;
var Depuis : integer; jusqua : Integer = 0):integer; register;
begin
initBMH_sauts(SubSTR,Pour_Pos);
Result:=Pos_BMH(SubSTR,STR,Pour_Pos,Depuis,jusqua);
end;
//****************Pilote Local---(à modifier suivant besoins********************
procedure Fab_arPiloc(actif : boolean = true);
var S : string; I,L : integer;
procedure change(charA,parB : char);
begin
S[ord(charA)]:=parB;
end;
begin
L:=Pred(sizeOf(TarPiLoc)); SetLength(S,L);
for I := 1 to L do S[I]:=chr(I);
if actif then
begin
//-----mofifs locales ici exemple e accentué------------------------
change('È','e'); change('É','E'); change('é','e'); change('è','e');
change('Ê','e'); change('ê','E');
//La conversion fait appel au pilote de langue Windows actuellement installé.
S:=AnsiUpperCase(S); //ISO-8859-1 (Ansi)
end;
//transfert
move(S[1],arPiLoc[chr(1)],L); arPiLoc[chr(0)]:=chr(0);
end;
procedure Differencier_MAJ_min(OK : boolean);
begin
Fab_arPiLoc(not OK);
end;
INITIALIZATION
initBMH_sauts(''); //BMH -> force brut (sécurité pour éviter 0 dans table)
Fab_arPiloc; //Pilote local
end.
Bonsoir,
Je livre ma modeste contribution dans cette course aux nanosecondes.
Ensuite je range mon tuto.
Ne rien lâcher dit Cirec,
Je fais relâche.
l'ASM c'est amusant et usant à la fois.
A Bientôt
le code de test
program test_POaSm;
{$APPTYPE CONSOLE}
uses
sysutils,
POaSm in 'POaSm.pas';
var TS : TBMH_sauts;
M,T,S : string;
D,R,J,F : integer;
var RPL : TreTxt;
procedure Fab_M_T;
var L :integer;
begin
L:=257;
SetLength(M,L); fillchar(M[1],L,'J'); M[1]:='A';
SetLength(T,Pred(L)); fillchar(T[1],pred(L),'X');
T:=T+M;
end;
begin
// Insérer le code utilisateur ici
M:='012345'; T:='aaaaaaB012345aa012345012345';
writeln('mot:',M,' texte:',T);
//test sans initialiser la table de sauts
D:=1; R:=Pos_BMH(M,T,D);
writeln('table de sauts non initialisee');
writeln('position de :',M,' -> texte[',R,']');
writeln;
initBMH_sauts(M);
D:=1; R:=Pos_BMH(M,T,D);
writeln('table de sauts initialisee');
writeln('position de :',M,' -> texte[',R,']');
writeln;
initBMH_sauts(M,TS);
D:=1; R:=Pos_BMH(M,T,TS,D);
writeln('table de sauts en parametre');
writeln('position de :',M,' -> texte[',R,']');
writeln;
D:=1; R:=PosDJ(M,T,D);
writeln('table de sauts par defaut PosDJ');
writeln('position de :',M,' -> texte[',R,']');
writeln;
writeln('recherches d''occurrences');
D:=1; R:=1; J:=0;
while R <> 0 do begin R:=PosDJ(M,T,D); if R <> 0 then inc(J); end;
writeln('il y a ',J,' occurrences de :',M,' dans :',T);
writeln;
Fab_M_T;
writeln('mot : ',length(M),' texte : ',length(T));
initBMH_sauts(M,TS);
D:=1; R:=Pos_BMH(M,T,TS,D);
writeln('position de mot long:STR[',R,']');
writeln;
// suite d'erreurs
D:=1; write(Pos_BMH('',T,D),' ');
write(Pos_BMH(M,'',D),' ');
D:=100; write(Pos_BMH(M,T,D),' ');
D:=-1; write(Pos_BMH(M,T,D),' ');
J:=100; write(Pos_BMH('',T,D,J),' ');
writeln('suite d''erreurs sans plantage ?');
writeln;
//pilote locale
S:='éèeE'; T:='-éééé--èèèè--eeee--EEEE--eeee-';
initPiloc(S,RPL);
writeln('recherche e accentue');
D:=3; F:=length(T)-3;
Repeat
R:=POS_BMH_txt(RPL,T,D,F);
if R <> 0 then writeln('pos de S dans T : ',R);
Until R = 0;
writeln;
D:=3; F:=length(T)-3;
initPiloc(S);
Repeat
R:=POS_BMH_txt(T,D,F);
if R <> 0 then writeln('pos de S dans T : ',R);
Until R = 0;
writeln;
D:=3; F:=length(T)-3;
Repeat
R:=POSDJ_txt(S,T,D,F);
if R <> 0 then writeln('pos de S dans T : ',R);
Until R = 0;
readln;
end.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 Modifié par Cirec le 19/06/2015 à 13:09
Reponse au message de cs_pseudo3- du 17 juin 2015 à 17:05 re
1er point je reviendrais dessus dans un autre message ;)
2eme point
"quand je disais de varier les éléments de recherches c'est pas à ça que je pensais, il faudrait rester dans un cadre utile et naturel .... une recherche de 510 caractères identiques c'est pas une chose courante ;) ":
J'ai opté pour cette solution pour deux raisons :
- le Boyer-Moore avance à grands pas dans les zones où le Mot est absent d'où la recherche avec une chaîne longue,
- et lors d'une discussion avec Rekin85 (KR85) il a évoqué l'exemple d'une utilisation par un prof pour rechercher des plagiats par copier-coller de grande longueur.
ça me revient maintenant pourquoi j'ai dit cela
ça t'aurais permis de découvrir ou de constater des erreurs dans le code !!!
en effet c'est grâce à l'utilisation de texte "normal" comme dans mon exemple que l'on s'en rend compte ;)
ceci est aussi valable pour la derniere version BMHPascalNaif
le 3ème point étant réglé on passe au suivant.
4ème point
" ... et tu as utilisé, pour tes testes, la varsion Byte "array[Byte] of Byte" alors que la version Integer "array[Byte] of Integer" est plus rapide ;)" :
Bin j'ai utilisé le code tel quel ne sachant pas ceci.
Je fais comment pour utiliser la version plus rapide et quel est l'intérêt de la version moins rapide ???
Alors comment dire ...
- si je fourni un code complet avec *.pas + *. dfm + *.dpr
- si je mets des commentaires dans le code que j'ai doublé dans le message
- si vous n'en copiez qu'une partie pour vos essais
... je n'y peux rien ! t'as oublié de prendre la ligne qui contient la compilation conditionnelle ce qui a provoqué
la compilation du code avec array of Byte à la place de array of Integer
{$DEFINE USE_INT} // en ajoutant un point à{.$DEFINE USE_INT} // vous desactivez la condition et vous passez // de array[Byte] of Integer // à array[Byte] of Byte
le 5ème point sur le fond tu as raison mais sur la forme je ne suis pas d'accord
d'une fonction de recherche j'attends quelle me permette de faire ma recherche
- en case sensitive,
- en non case sensitive,
- en tenant compte des accents,
- en ne tenant pas compte des accents
- en case sensitive, en tenant compte des accents,
- en case sensitive, en ne tenant pas compte des accents
- en non case sensitive, en tenant compte des accents,
- en non case sensitive, en ne tenant pas compte des accents
alors que dans ton cas il ne reste plus que:
- en case sensitive, en tenant compte des accents,
- en non case sensitive, en ne tenant pas compte des accents
réponse au message suivant: chez moi que ce soit sur le vieux PC ou sur I7
la BMHPascalNaif reste bonne dernière !!!!!!
Mais le plus important c'est qu'elle n'est pas juste dans ses résultats !
alors que toutes les fonctions donnent un résultat de 100 occurrences trouvées sauf les non case sensitive qui elles en trouvent 104 ce qui est juste ;)
la BMHPascalNaif n'en trouve que 80 !!!
Pour 10 000 - Recherches de " Modif " dans 64 068 Caractères: avec array[Byte] of Integer Avec StrUtils.PosEx ASM version => Trouvé : 100 fois, Mis : 532 ms dont 532 ms uniquement pour les appels à StrUtils.PosEx
Avec PosBM_Mickey974ModifExPByte => Trouvé : 100 fois, Mis : 1 390 ms dont 1 374 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 104 fois, Mis : 1 563 ms dont 1 516 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
Avec PosBM_Mickey974ModifExPChar => Trouvé : 100 fois, Mis : 1 375 ms dont 1 360 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec PosBM_Mickey974Modif => Trouvé : 100 fois, Mis : 890 ms dont 890 ms uniquement pour les appels à PosBM_Mickey974Modif
Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 104 fois, Mis : 1 063 ms dont 1 032 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
Avec BMHPascalNaif => Trouvé : 80 fois, Mis : 1 500 ms dont 1 500 ms uniquement pour les appels à BMHPascalNaif
la première erreur est assez facile à mettre en évidence.
il suffit de rechercher un mot qui commence au tout début du texte:
ceci devrait faire l'affaire:
Texte := 'une chaine de texte .....pour une.....dans une etc. etc.';
Mot := 'une'
Comme les résultats de mes tests de vitesse d'hier m'ont un peu intrigué, en méditant sur ce sujet j'ai pris conscience qu'en faisant des recherches avec un mot du style StringOfChar('A', 510) j'avais placé malencontreusement les routines de Cirec en situation de ramer avec de nombreux sauts de 1 et quelques rares sauts de 510 vu la SkipTable que ça donne.
Donc voici les résultats plus réalistes avec un mot à rechercher de même longueur qu'hier mais formé par une chaîne aléatoire de Majuscules présent 6 fois dans un texte où il est séparé par des Minuscules aléatoires :
Pour 1 000 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: Compilé avec array[Byte] of Integer
Avec :
Mot := StrAleatoireMajus(510);
Separ := StrAleatoireMinus(1020);
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
Nouveaux résultats :
- Avec StrUtils.PosEx ASM version => Trouvé : 6 fois, Mis : 2 060 ms dont 1 936 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 2 776 ms dont 2 634 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 4 087 ms dont 3 947 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 2 574 ms dont 2 389 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 2 184 ms dont 2 091 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 3 526 ms dont 3 494 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec PosPietteASM => Trouvé : 6 fois, Mis : 10 343 ms dont 10 155 ms uniquement pour les appels à PosPietteASM
- Avec BMHPascalNaif => Trouvé : 6 fois, Mis : 1 794 ms dont 1 701 ms uniquement pour les appels à BMHPascalNaif
Les écarts de vitesse sont moins importants qu'hier mis à part pour ce qui concerne PosPietteASM ce qui est normal vu que ce n'est pas du Boyer-Morre
Par contre BMHPascalNaif reste pour l'instant la meilleure grâce au coulisseau à 2 trous qui vérifie s'il y a concordance simultanée sur la dernière lettre ET la première du mot cherché avant d'entamer la marche à reculons.
J'aime bien ce coulisseau à 2 trous car beaucoup de mots se terminent par la même lettre, ceux qui commencent avec la même et se terminent avec une même autre sont bien moins nombreux,
et ceux qui en plus ont la même longueur sont encore moins nombreux.
En plus si on tient compte du fait que beaucoup de mots se terminent par une séquence de caractères suffixes identiques comme par exemple :
- annuellement, cruellement, perétuellement, mensuellement, intellectuellement, spirituellement, graduellement, etc.
Dans ces cas les versions Boyer-Moore de Cirec, dès qu'il y a concordance sur le t terminal se précipitent à reculer jusqu'au u en perdant leur temps alors que la BMHPascalNaif gagne du temps s'il n'y a pas en même temps concordance sur la première lettre.
Et visiblement, ayant fait plusieurs tests similaires avec des mots et du texte aléatoires ceci se produit statistiquement fréquemment, donc si ça se produit même avec de l'aléatoire ça se produit forcément avec du langage courant.
Voici d'abord les résultats de tests comparatifs de vitesse de codes dont un nouveau Boyer-Moore en Pascal qui décoiffe :
Avec les paramètres de recherche suivants :
Mot := StringOfChar('M', 510);
Separ := StrAleatoireMinus(1020); // Chaîne aléatoire de minuscules
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
nbTours := 10000;
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 6 fois, Mis : 187 ms dont 171 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 5 866 ms dont 5 866 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 7 800 ms dont 7 800 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 5 631 ms dont 5 631 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 4 010 ms dont 4 010 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 5 818 ms dont 5 818 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec PosPascalNaif => Trouvé : 6 fois, Mis : 141 ms dont 141 ms uniquement pour les appels à PosPascalNaif
- Avec BMHPascalNaif => Trouvé : 6 fois, Mis : 15 ms dont 15 ms uniquement pour les appels à BMHPascalNaif
et même PosPascalNaif qui marche uniquement en avançant est plus rapide que la PosEx en ASM issu du challenge de Fastcode !!!
Et voici le code du Boyer-Moore en Pascal qui décoiffe :
function BMHPascalNaif(const Mot, Texte: AnsiString; var Depuis: Integer): Integer; var rm, im, it, ik, LM, LT: integer; begin Result := 0; LM := Length(Mot); LT := length(Texte); if (LM = 0) or (LT = 0) then EXIT; if (Depuis < 1) then Depuis := 1; //--------------------------------------------------------------- ik := Depuis + LM - 1; while (ik <= LT) do begin it := ik; im := LM; rm := LM - 1; if (Texte[it] = Mot[im]) and (Texte[it - rm] = Mot[1]) then // < Pochoir coulissant à 2 trous while Texte[it] = Mot[im] do begin Dec(im); Dec(it); dec(rm); end; if rm < 0 then begin Result := it; Depuis := it; EXIT; // Occurrence Trouvée end else begin Inc(ik, skip2[Texte[ik]]); end; end; Result := 0; Depuis := 1; end;
Et voici le code de PosPascalNaif qui marche seulement en avançant :
function PosPascalNaif(const Mot, Texte: AnsiString; var Depuis: Integer; Jusqua: Integer): Integer; var rt, im, it, LM, LT: integer; begin Result := 0; LM := Length(Mot); LT := length(Texte); if (LM = 0) or (LT = 0) then EXIT; if (Depuis < 1) then Depuis := 1; if (Jusqua <= 0) or (Jusqua > LT) then jusqua := LT; rt := Jusqua - (Depuis + LM) + 2; // Reste à tester if rt < 1 then EXIT; //--------------------------------------------------------------- repeat if Mot[1] = Texte[Depuis] then begin im := 2; it := Depuis + 1; while im <= LM do if Mot[im] = Texte[it] then begin inc(im); inc(it); end;
if im = LM + 1 then begin // Occurrence trouvée à Depuis : EXIT Result := Depuis; inc(Depuis, LM); EXIT; end; end; inc(Depuis); dec(rt); until rt = 0; // Si pas EXIT donc pas trouvé Depuis := 1; Result := 0; end;
1) A propos de PosEX ASM : "La version ASM devient plus rapide de 1 à 8 caractères et à 9 caractères elle est identique à la version string
et à partir de 10 caractères recherchés c'est la version string qui prend la main." :
Chez moi c'est la PosEx que je viens de récupérer qui reste la plus rapide même avec les 510 caractères de tout à l'heure : Elle décoiffe carrément :
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: avec array[Byte] of Byte
Avec StrUtils.PosEx ASM version => Trouvé : 6 fois, Mis : 218 ms dont 203 ms uniquement pour les appels à StrUtils.PosEx
Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 5 351 ms dont 5 351 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 6 973 ms dont 6 973 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 4 883 ms dont 4 883 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 4 009 ms dont 4 009 ms uniquement pour les appels à PosBM_Mickey974ModifString
Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 5 897 ms dont 5 897 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
2) "quand je disais de varier les éléments de recherches c'est pas à ça que je pensais, il faudrait rester dans un cadre utile et naturel .... une recherche de 510 caractères identiques c'est pas une chose courante ;) ":
J'ai opté pour cette solution pour deux raisons :
- le Boyer-Moore avance à grands pas dans les zones où le Mot est absent d'où la recherche avec une chaîne longue,
- et lors d'une discussion avec Rekin85 (KR85) il a évoqué l'exemple d'une utilisation par un prof pour rechercher des plagiats par copier-coller de grande longueur.
3) " ... et le texte servant à la recherche ne contient que 2 caractères répétés" :
OK, pour la suite j'utiliserai du texte aléatoire.
4) " ... et tu as utilisé, pour tes testes, la varsion Byte "array[Byte] of Byte" alors que la version Integer "array[Byte] of Integer" est plus rapide ;)" :
Bin j'ai utilisé le code tel quel ne sachant pas ceci.
Je fais comment pour utiliser la version plus rapide et quel est l'intérêt de la version moins rapide ???
5) "... non c'est l'inverse "or $20" convertit les majuscules en minuscules tout en conservant les accents. c'est un choix délibéré de ma part, dans les recherches la case et les accents sont deux paramètres distincts" :
Ok, mais si on conserve les accents on risque d'avoir des résultats de recherche incomplets à cause de Textes pollués par des erreurs d'accentuation, alors qu'en convertissant en minuscules ou en majuscules non accentuées on gomme du même coup ces erreurs.
Cordialement, et à +.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 17 juin 2015 à 14:40
A) Mis à part [Erreur] uCompareStrPos.pas(2088): Identificateur non déclaré : PosEx,
ce qui est normal car PosEx n'est apparu qu'après D6 que j'utilise le reste fonctionne correctement.
En plus si PosEx du Fastcode Challange reste la meilleurs pour une recherche de 1 à 3 caractères il resterait à savoir si elle resterait la meilleure pour la recherche de chaînes longues.
Effectivement ... et ça m'a même permis de constater que la version ASM de PosEx ne figurait pas dans les sources de D7 !!!
Mais elle y est dans Delphi2009 avec une prise en charge de l'unicode.
Pas de panique vous pouvez télécharger le zip du fastcode challange sur le site (voir mon premier message)
ou sinon vous recopiez ce qui suit :
unit : PosExJOHUnit.pas
unit PosExJOHUnit;
interface
function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer;
implementation
//PosEx_JOH_IA32_7_a
function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer;
asm {180 Bytes}
push ebx
cmp eax, 1
sbb ebx, ebx {-1 if SubStr = '' else 0}
sub edx, 1 {-1 if S = ''}
sbb ebx, 0 {Negative if S = '' or SubStr = '' else 0}
dec ecx {Offset - 1}
or ebx, ecx {Negative if S = '' or SubStr = '' or Offset < 1}
jl @@InvalidInput
push edi
push esi
push ebp
push edx
mov edi, [eax-4] {Length(SubStr)}
mov esi, [edx-3] {Length(S)}
add ecx, edi
cmp ecx, esi
jg @@NotFound {Offset to High for a Match}
test edi, edi
jz @@NotFound {Length(SubStr = 0)}
lea ebp, [eax+edi] {Last Character Position in SubStr + 1}
add esi, edx {Last Character Position in S}
movzx eax, [ebp-1] {Last Character of SubStr}
add edx, ecx {Search Start Position in S for Last Character}
mov ah, al
neg edi {-Length(SubStr)}
mov ecx, eax
shl eax, 16
or ecx, eax {All 4 Bytes = Last Character of SubStr}
@@MainLoop:
add edx, 4
cmp edx, esi
ja @@Remainder {1 to 4 Positions Remaining}
mov eax, [edx-4] {Check Next 4 Bytes of S}
xor eax, ecx {Zero Byte at each Matching Position}
lea ebx, [eax-$01010101]
not eax
and eax, ebx
and eax, $80808080 {Set Byte to $80 at each Match Position else $00}
jz @@MainLoop {Loop Until any Match on Last Character Found}
bsf eax, eax {Find First Match Bit}
shr eax, 3 {Byte Offset of First Match (0..3)}
lea edx, [eax+edx-4] {Address of First Match on Last Character}
@@Compare:
inc edx
cmp edi, -4
jle @@Large {Lenght(SubStr) >= 4}
cmp edi, -1
je @@SetResult {Exit with Match if Lenght(SubStr) = 1}
mov ax, [ebp+edi] {Last Char Matches - Compare First 2 Chars}
cmp ax, [edx+edi]
jne @@MainLoop {No Match on First 2 Characters}
@@SetResult: {Full Match}
lea eax, [edx+edi] {Calculate and Return Result}
pop edx
pop ebp
pop esi
pop edi
pop ebx
sub eax, edx {Subtract Start Position}
ret
@@NotFound:
pop edx {Dump Start Position}
pop ebp
pop esi
pop edi
@@InvalidInput:
pop ebx
xor eax, eax {No Match Found - Return 0}
ret
@@Remainder: {Check Last 1 to 4 Characters}
sub edx, 4
@@RemainderLoop:
cmp cl, [edx]
je @@Compare
cmp edx, esi
jae @@NotFound
inc edx
jmp @@RemainderLoop
@@Large:
mov eax, [ebp-4] {Compare Last 4 Characters}
cmp eax, [edx-4]
jne @@MainLoop {No Match on Last 4 Characters}
mov ebx, edi
@@CompareLoop: {Compare Remaining Characters}
add ebx, 4 {Compare 4 Characters per Loop}
jge @@SetResult {All Characters Matched}
mov eax, [ebp+ebx-4]
cmp eax, [edx+ebx-4]
je @@CompareLoop {Match on Next 4 Characters}
jmp @@MainLoop {No Match}
end; {PosEx}
end.
du coup les résultats changent radicalement ^^
La version ASM devient plus rapide de 1 à 8 caractères et à 9 caractères elle est identique à la version string
et à partir de 10 caractères recherchés c'est la version string qui prend la main.
B) Vitesses avec :
Mot := StringOfChar('M', 510);
Separ := StringOfChar('o', 1020);
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
Résultats avec Intel Core i7 - 2700 K à 3, 5 GHz :
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: avec array[Byte] of Byte
quand je disais de varier les éléments de recherches c'est pas à ça que je pensais
il faudrait rester dans un cadre utile et naturel .... une recherche de 510 caractères identiques c'est pas une chose courante ;)
et le texte servant à la recherche ne contient que 2 caractères répétés
c'est pas très réaliste !
et tu as utilisé, pour tes testes, la varsion Byte "array[Byte] of Byte"
alors que la version Integer "array[Byte] of Integer" est plus rapide ;)
sauf erreur de ma part avec 'or $20' on ne convertit en Majuscules que les Minuscules non accentuées et le texte risque de comporter des alphabétiques accentués voire être pollué par des erreurs d'accents.
non c'est l'inverse "or $20" convertit les majuscules en minuscules tout en conservant les accents.
c'est un choix délibéré de ma part
dans les recherches la case et les accents sont deux paramètres distinct
Résultats des tests du code de Cirec:
A) Mis à part [Erreur] uCompareStrPos.pas(2088): Identificateur non déclaré : PosEx,
ce qui est normal car PosEx n'est apparu qu'après D6 que j'utilise le reste fonctionne correctement.
En plus si PosEx du Fastcode Challange reste la meilleurs pour une recherche de 1 à 3 caractères il resterait à savoir si elle resterait la meilleure pour la recherche de chaînes longues.
B) Vitesses avec :
Mot := StringOfChar('M', 510);
Separ := StringOfChar('o', 1020);
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
Résultats avec Intel Core i7 - 2700 K à 3, 5 GHz :
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: avec array[Byte] of Byte
Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 5 366 ms dont 5 366 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 6 989 ms dont 6 989 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 4 883 ms dont 4 883 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 4 009 ms dont 4 009 ms uniquement pour les appels à PosBM_Mickey974ModifString
Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 5 897 ms dont 5 897 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
Donc chez moi aussi c'est la version string qui reste la plus rapide.
Par contre il reste un petit truc qui me chagrine dans InitFastSkip:
if CaseSensitive then FastSkip[PByte(pb + k - 1)^] := LenSub - k else FastSkip[PByte(pb + k - 1)^ or $20] := LenSub - k;
sauf erreur de ma part avec 'or $20' on ne convertit en Majuscules que les Minuscules non accentuées et le texte risque de comporter des alphabétiques accentués voire être pollué par des erreurs d'accents.
Pour ma part je préférerais utiliser pour cela une solution telle que l'utilisation de la constante MNA même si l'initialisation de la SkipTable est un chouilla plus lente, d'autant plus qu'on ne l'initialise qu'une seule fois en dehors des boucles d'appel et que ce n'est donc pas lors de cette initialisation qu'on cherche des gains de vitesse importants mais lors des boucles d'appel qui s'effectuent généralement avec la recherche du même Mot dans une série de N Textes différents.
Du coup je vais essayer de bidouiller InitFastSkip pour utiliser MNA.
Et comme le disait Cirec : "il ne reste plus qu'à tester une version ASM".
Réponse au message de Cirec du 16 juin 2015 à 14:46
>> "j'ai fait de mon coté quelques testes dont je vous livre le code ... testez par vous même les résultats étant différents en fonction des compilateurs et des PC.
Je vous conseille de changer votre texte mais surtout le mot de recherche en faisant varier sa longueur de 1 à plus de 8 caractères" :
OK, merci pour cette contribution, je vais tester le code dès aujourd'hui puis en donner les résultats.
Réponse aux messages de Piette du 16 juin 2015 à 23:27 et du 17 juin 2015 à 00:30
>> "Je n'arrive pas à lire votre table MNA ?
ici -> f"...+
la -> /00S<OE
puis -> µ¶·¸¹º»¼½¾¿"
C'est très simple la table MNA a été créée en y plaçant dans un premier temps tous les Chr(i) avec i de 0 à 255, et en y remplaçant dans un deuxième temps tous les caractères alphabétiques par leur Majuscule Non Accentuée.
Cela évite aux recherches d'être perturbées par des fautes d'orthographe fréquentes en particulier sur le choix des accents.
>> "La syntaxe est : const X : array[1..2] of char = ('A','B');" :
Bin non comme la table des caractères en contient 256 ce n'est pas array[1..2] of char mais array[Char] of Char
>> "Je pense qu'il serait moins fastidieux de placer votre table MNA dans un string?" :
Fastidieux pour quelle raison ? Je ne comprends pas d'autant plus qu'un string équivaut à une table indicée.
Par contre si ça devait améliorer la vitesse d'exécution je serais preneur.
Réponse au message de Piette du 16 juin 2015 à 15:33
>> "Savez vous s'il existe l'équivalent de AnsiUppercase pour un char?":
Cet équivalent présenterait l'incovénient de remplacer un 'é ' par 'É' donc s'il y une erreur d'accent et que dans le texte on a un 'ê' à la place du 'é' on loupe la recherche.
Alors que l'utilisation de la constante MNA remplace TOUS les caractères alphabétiques par des Majuscules Non Accentués
>> "il me semblait recevoir ? des alertes lorsqu'il arrivait des messages, est-ce toujours le cas? (sauf pour moi)" :
Effectivement à une autre époque nous étions alertés par un mail chaque fois que quelqu'un ajoutait un commentaire ou une réponse. Et cette fonctionnalité manque cruellement.
Donc si quelqu'un pose une question sur un code qu'on a publié il y a quelques années la question risque de rester sans réponse jusqu'au jour où l'auteur du code passe par hasard par là et s'il répond à la question
plusiuers mois après c'est le questionneur qui ne saura pas qu'on lui a répondu.
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 17 juin 2015 à 00:30
ReBonsoir,
Je pense qu'il serait moins fastidieux de placer votre table MNA dans un string?
Salutations
Bonjour,
Savez vous s'il existe l'équivalent de AnsiUppercase pour un char?
String:=AnsiUpperCase(string);
Char:=Ansi??????????(char);
autre question basique:
il me semblait recevoir ? des alertes lorsqu'il arrivait des messages, est-ce toujours le cas? (sauf pour moi)
Salutations
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 Modifié par Cirec le 16/06/2015 à 15:09
Salut,
j'ai fait de mon coté quelques testes dont je vous livre le code ... testez par vous même les résultats étant différents en fonction des compilateurs et des PC.
Je vous conseille de changer votre texte mais surtout le mot de recherche en faisant varier sa longueur de 1 à plus de 8 caractères
le code fourni prévoit tout ceci
il vous faut 1 TButton 1 TEdit 2 TMemo et "Facultatif" 1 TSpinEdit pour le nombre de répétitions
MainForm: unit4.pas
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Spin;
type
TForm4 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Panel1: TPanel;
Splitter1: TSplitter;
Edit1: TEdit;
SpinEdit1: TSpinEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
procedure Trace(const aStr: string);
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
uses StrUtils; // pour PosEx
{$DEFINE USE_INT} // en ajoutant un point à{.$DEFINE USE_INT}
// vous desactivez la condition et vous passez
// de array[Byte] of Integer
// à array[Byte] of Byte
type
TFastSkip = array[Byte] of {$IFDEF USE_INT}Integer{$ELSE}Byte{$ENDIF};
var
FastSkip: TFastSkip;
// procedure pour remplir un tableau d'entiers plus rapidement.
procedure _FillInt(var Dest; count: Integer; Value: Integer);
asm
{ ->EAX Pointer to destination }
{ EDX count }
{ ECX value }
PUSH EDI
MOV EDI,EAX { Point EDI to destination }
MOV EAX,ECX
MOV ECX,EDX
REP STOSD { Fill count dwords }
POP EDI
end;
// valable pour toutes les version Case Sensitive ou non Byte ou Integer
procedure InitFastSkip(ASubStr: string; const CaseSensitive: Boolean = True); // Initialisation de la Skip-table
var LenSub, k: integer;
pb: PChar;
begin
LenSub := Length(ASubStr);
pb := PChar(aSubStr);
{$IFDEF USE_INT}
_FillInt(FastSkip, 256, LenSub);
{$ELSE}
FillChar(FastSkip, 256, LenSub);
{$ENDIF}
for k := 1 to Pred(LenSub) do
if CaseSensitive then
FastSkip[PByte(pb+k-1)^] := LenSub - k
else
FastSkip[PByte(pb+k-1)^ or $20] := LenSub - k;
// FastSkip[PByte(Integer(pb)+k-1)^] := LenSub - k;
end;
// la version PByte
function PosBM_Mickey974ModifExPByte(const Mot, Texte: string; Depuis: integer): integer;
label SuffixePasBon, Boucler;
var i, j, k, LT, LM: integer;
pM, pT: PByte;
begin
LM := Length(Mot) - 1; LT := Length(Texte) - 1;
k := Depuis + LM - 1;
pM := PByte(Mot);
pT := PByte(Texte);
while (k <= LT) do begin
i := k;
j := LM;
Boucler:
if PByte(Integer(pT)+i)^ <> PByte(Integer(pM)+j)^ then begin // Suffixe Pas Ok on avance avec les sauts de la Skip-table
Inc(k, FastSkip[PByte(Integer(pT)+k)^]);
goto SuffixePasBon;
end else begin // Suffixe Ok on recule pour comparer les caractères précédents
Dec(j);
Dec(i);
if j >= 0 then goto Boucler;
// sinon si j = 0 on a trouvé une occurrence en i et EXIT
end;
Result := i + 2;
EXIT;
SuffixePasBon:
end;
Result := -1;
end;
// la version PByte Non Case Sansitive
function PosBM_Mickey974ModifExPByteNonCaseSansitive(const Mot, Texte: string;const Depuis: integer = 1): integer;
label SuffixePasBon, Boucler;
var i, j, k, LT, LM: integer;
pM, pT: PByte;
begin
LM := Length(Mot) - 1; LT := Length(Texte) - 1;
k := Depuis + LM - 1;
pM := PByte(Mot);
pT := PByte(Texte);
while (k <= LT) do begin
i := k;
j := LM;
Boucler:
if (PByte(Integer(pT)+i)^ or $20) <> (PByte(Integer(pM)+j)^ or $20) then begin // Suffixe Pas Ok on avance avec les sauts de la Skip-table
Inc(k, FastSkip[PByte(Integer(pT)+k)^ or $20]);
goto SuffixePasBon;
end else begin // Suffixe Ok on recule pour comparer les caractères précédents
Dec(j);
Dec(i);
if j >= 0 then goto Boucler;
// sinon si j = 0 on a trouvé une occurrence en i et EXIT
end;
Result := i + 2;
EXIT;
SuffixePasBon:
end;
Result := -1;
end;
// la version PChar
function PosBM_Mickey974ModifExPChar(const Mot, Texte: string; Depuis: integer): integer;
label SuffixePasBon, Boucler;
var i, j, k, LT, LM: integer;
pM, pT: PChar;
begin
LM := Length(Mot)-1; LT := Length(Texte)-1;
k := Depuis + LM - 1;
pM := PChar(Mot);
pT := PChar(Texte);
while (k <= LT) do begin
i := k;
j := LM;
Boucler:
if PChar(pT+i)^ <> PChar(pM+j)^ then begin // Suffixe Pas Ok on avance avec les sauts de la Skip-table
Inc(k, FastSkip[PByte(pT+k)^]);
goto SuffixePasBon;
end else begin // Suffixe Ok on recule pour comparer les caractères précédents
Dec(j);
Dec(i);
if j >= 0 then goto Boucler;
// sinon si j = 0 on a trouvé une occurrence en i et EXIT
end;
Result := i + 2;
EXIT;
SuffixePasBon:
end;
Result := -1;
end;
// la version string
function PosBM_Mickey974Modif(const Mot, Texte: string; Depuis: integer): integer;
label SuffixePasBon, Boucler;
var i, j, k, LT, LM: integer;
begin
LM := Length(Mot); LT := Length(Texte);
k := Depuis + LM - 1;
while (k <= LT) do begin
i := k;
j := LM;
Boucler:
if Texte[i] <> Mot[j] then begin // Suffixe Pas Ok on avance avec les sauts de la Skip-table
// Inc(k, skip2[AnsiChar(Texte[k])]);
Inc(k, FastSkip[Byte(Texte[k])]);
goto SuffixePasBon;
end else begin // Suffixe Ok on recule pour comparer les caractères précédents
Dec(j);
Dec(i);
if j > 0 then goto Boucler;
// sinon si j = 0 on a trouvé une occurrence en i et EXIT
end;
Result := i + 1;
EXIT;
SuffixePasBon:
end;
Result := -1;
end;
// la version string Non Case Sansitive
function PosBM_Mickey974ModifNonCaseSansitive(const Mot, Texte: string; Depuis: integer): integer;
label SuffixePasBon, Boucler;
var i, j, k, LT, LM: integer;
begin
LM := Length(Mot); LT := Length(Texte);
k := Depuis + LM - 1;
while (k <= LT) do begin
i := k;
j := LM;
Boucler:
if Byte(Texte[i]) or $20 <> Byte(Mot[j]) or $20 then begin // Suffixe Pas Ok on avance avec les sauts de la Skip-table
Inc(k, FastSkip[Byte(Texte[k])or $20]);
goto SuffixePasBon;
end else begin // Suffixe Ok on recule pour comparer les caractères précédents
Dec(j);
Dec(i);
if j > 0 then goto Boucler;
// sinon si j = 0 on a trouvé une occurrence en i et EXIT
end;
Result := i + 1;
EXIT;
SuffixePasBon:
end;
Result := -1;
end;
procedure TForm4.Button1Click(Sender: TObject);
var Mot, Texte: string; I, LM, LT, Depuis, Po: integer;// skip: tSkip2;
GTC1, GTC2, Mis, nbTours, Count: longWord;
aStr: string;
begin
// Mot := '56789';
// Texte := '012345678901234567890123456789012345678901234567890123456789123';
Mot := Edit1.Text;
Texte := Memo2.Text;
LM := length(Mot); LT := length(Texte);
Count := 0;
nbTours := SpinEdit1.Value;
aStr := Format('Pour %.0n - Recherches de " %s " dans %.0n Caractères: avec array[Byte] of %s',[nbTours / 1, Mot, LT / 1, {$IFDEF USE_INT}'Integer'{$ELSE}'Byte'{$ENDIF}]);
Trace('********************************************************************************');
GTC1 := GetTickCount; Mis := 0;
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosEx(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosEx(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(aStr);
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['StrUtils.PosEx ASM version',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'StrUtils.PosEx']));
Trace('');
GTC1 := GetTickCount; Mis := 0; InitFastSkip(Mot);
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifExPByte(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifExPByte(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(aStr);
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['PosBM_Mickey974ModifExPByte',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'PosBM_Mickey974ModifExPByte']));
Trace('');
GTC1 := GetTickCount; Mis := 0; InitFastSkip(Mot, False);
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifExPByteNonCaseSansitive(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifExPByteNonCaseSansitive(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(aStr);
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['PosBM_Mickey974ModifExPByteNonCaseSansitive',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'PosBM_Mickey974ModifExPByteNonCaseSansitive']));
Trace('');
GTC1 := GetTickCount; Mis := 0; InitFastSkip(Mot);
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifExPChar(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifExPChar(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(aStr);
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['PosBM_Mickey974ModifExPChar',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'PosBM_Mickey974ModifExPChar']));
Trace('');
GTC1 := GetTickCount; Mis := 0; InitFastSkip(Mot);//InitSkip2(Mot);
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosBM_Mickey974Modif(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosBM_Mickey974Modif(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(aStr);
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['PosBM_Mickey974Modif',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'PosBM_Mickey974Modif']));
Trace('');
GTC1 := GetTickCount; Mis := 0; InitFastSkip(Mot, False);//InitSkip2(Mot);
for i := 1 to nbTours do begin
Count := 0; Depuis := 1;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifNonCaseSansitive(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
while Po > 0 do begin
inc(Count);
Depuis := Po + LM + 1;
if Depuis >= LT then break;
GTC2 := GetTickCount;
Po := PosBM_Mickey974ModifNonCaseSansitive(Mot, Texte, Depuis);
Mis := Mis + (GetTickCount - GTC2);
end;
end;
Trace(aStr);
Trace(Format('Avec %s => Trouvé : %.0n fois, Mis : %.0n ms dont %.0n '+
'ms uniquement pour les appels à %s', ['PosBM_Mickey974ModifNonCaseSansitive',
Count / 1, (GetTickCount - GTC1) / 1, Mis / 1, 'PosBM_Mickey974ModifNonCaseSansitive']));
Trace(#13#10'Teste Terminé');
end;
// Affiche les résultats dans Memo1
procedure TForm4.Trace(const aStr: string);
begin
Memo1.Lines.Add(aStr);
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
Caption := Format('Compilé avec array[Byte] of %s',[{$IFDEF USE_INT}'Integer'{$ELSE}'Byte'{$ENDIF}]);
Memo1.Clear;
// ici on charge 4 fois cette unité ce qui donne un bon fichier pour la recherche ^^
Memo2.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'Unit4.pas');
Memo2.Lines.AddStrings(Memo2.Lines);
Memo2.Lines.AddStrings(Memo2.Lines);
end;
end.
Voici le dfm : unit4.dfm
object Form4: TForm4
Left = 198
Top = 114
Width = 841
Height = 726
Caption = 'Form4'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 0
Top = 405
Width = 833
Height = 3
Cursor = crVSplit
Align = alBottom
end
object Memo1: TMemo
Left = 0
Top = 65
Width = 833
Height = 340
Align = alClient
Lines.Strings = (
'Memo1')
ScrollBars = ssBoth
TabOrder = 1
end
object Memo2: TMemo
Left = 0
Top = 408
Width = 833
Height = 284
Align = alBottom
Lines.Strings = (
'Memo2')
ScrollBars = ssBoth
TabOrder = 2
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 833
Height = 65
Align = alTop
TabOrder = 0
object Button1: TButton
Left = 8
Top = 16
Width = 75
Height = 25
Caption = 'Button1'
Default = True
TabOrder = 0
OnClick = Button1Click
end
object Edit1: TEdit
Left = 168
Top = 18
Width = 121
Height = 21
TabOrder = 1
Text = 'Modif'
end
object SpinEdit1: TSpinEdit
Left = 328
Top = 16
Width = 121
Height = 22
Increment = 10000
MaxValue = 0
MinValue = 0
TabOrder = 3
Value = 10000
end
end
end
et le dpr : project5.dpr
program Project5;
uses Forms, Unit4 in 'Unit4.pas' {Form4};
{$R *.res}
begin Application.Initialize; Application.CreateForm(TForm4, Form4); Application.Run; end.
J'ai également ajouté, par une compilation conditionnelle "{$DEFINE USE_INT}" au début de l'implémentation , la possibilité de tester la différence entre
array[Byte] of Integer;
et
array[Byte] of Byte;
ainsi qu'un teste avec la fonction PosEx du Fastcode Challange qui reste la meilleurs pour une recherche de 1 à 3 caractères ^^
chez moi la version string reste la plus rapide au delà de 4 caractères
il ne reste plus qu'à tester une version ASM ^^
Je tiens à rectifier mon code Pascal d'hier à propos duquel je disais " : utile si on cherche des mots dans des textes où le mot peut être tantôt en majuscules tantôt en minuscules voire avec des caractères accentués ou des accents faux ou oubliés" car je viens de me rendre compte que la fonction UpCase ne passe en majuscules que les chr de chr(97) à chr(122) et pas les caractères accentués ni le "ç" avec la cédille donc voici le code corrigé :
type tSkip22 = array[char] of longWord; var Skip22: tSkip22;
procedure InitSkip22(const Mot: string; const IgnoreCasse: Boolean); var LM, k: integer; Cara: char; begin LM := Length(Mot); for Cara := low(Char) to high(Char) do Skip22[Cara] := LM; if IgnoreCasse then begin for k := 1 to LM - 1 do Skip22[MNA[Mot[k]]] := LM - k; // < Modifié end else begin for k := 1 to LM - 1 do Skip22[Mot[k]] := LM - k; end; end;
function PosBM_Mickey_Ignore_Casse2(const Mot, Texte: string; Depuis: integer): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer; begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if MNA[Texte[i]] <> MNA[Mot[j]] then begin // < modifié Inc(k, skip22[MNA[Texte[k]]]); // < modifié goto SuffixePasBon; end else begin Dec(j); Dec(i); if j > 0 then goto Boucler; end; Result := i; EXIT; SuffixePasBon: end; Result := 0; end;
En fait l'utilisation de deux fonctions spécialisées dont l'une Ignore la casse et l'autre non ont quand même une petite différence de vitesse :
Pour Mot := '123456789' et Texte := 012345678901234567890123456789012345678901234567890123456789123
et nb-Recherches = 1000000 :
- Avec PosBM_Mickey_Ignore_Casse => Trouvé : 6 fois, Mis : 359 ms dont 154 ms uniquement pour les appels à PosBM_Mickey_Ignore_Casse
- Avec PosBM_Mickey974Modif_ => Trouvé : 6 fois, Mis : 187 ms dont 46 ms uniquement pour les appels PosBM_Mickey974Modif_
function PosBM_Mickey_Ignore_Casse(const Mot, Texte: string; Depuis: integer): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer;
begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if UpCase(Texte[i]) <> UpCase(Mot[j]) then begin Inc(k, skip22[UpCase(Texte[k])]); goto SuffixePasBon; end else begin Dec(j); Dec(i); if j > 0 then goto Boucler; end; Result := i; EXIT; SuffixePasBon: end; Result := 0; end;
Voici une modification du code Pascal pour Ignorer ou ne pas Ignorer les différences entre Majuscules et minuscules : utile si on cherche des mots dans des textes où le mot peut être tantôt en majuscules tantôt en minuscules voire avec des caractères accentués ou des accents faux ou oubliés.
type tSkip22 = array[char] of integer; var Skip22: tSkip22;
procedure InitSkip22(const Mot: string; const IgnoreCasse: Boolean); var LM, k: integer; Cara: char; begin LM := Length(Mot); for Cara := low(Char) to high(Char) do Skip22[Cara] := LM; if IgnoreCasse then begin for k := 1 to LM - 1 do Skip22[UpCase(Mot[k])] := LM - k; end else begin for k := 1 to LM - 1 do Skip22[Mot[k]] := LM - k; end; end;
function PosBM_Mickey_Casse(const Mot, Texte: string; Depuis: integer; const IgnoreCasse: Boolean): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer;
function MemeCaractere: Boolean; begin if IgnoreCasse then Result := UpCase(Texte[i]) = UpCase(Mot[j]) else Result := (Texte[i] = Mot[j]); end;
begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if not MemeCaractere then begin if IgnoreCasse then Inc(k, skip22[UpCase(Texte[k])]) else Inc(k, skip22[Texte[k]]); goto SuffixePasBon; end else begin Dec(j); Dec(i); if j > 0 then goto Boucler; end; Result := i; EXIT; SuffixePasBon: end; Result := 0; end;
Résultats de tests de vitesse :
Avec Mot := '123456789' et Texte := '012345678901234567890123456789012345678901234567890123456789123'
Pour nb-Recherches = 1000000 :
- Avec PosBM_Mickey_Casse => Trouvé : 6 fois, Mis : 328 ms dont 125 ms uniquement pour les appels à PosBM_Mickey_Casse (Sans ignorer la casse)
- Avec PosBM_Mickey_Casse => Trouvé : 6 fois, Mis : 468 ms dont 328 ms uniquement pour les appels à PosBM_Mickey_Casse (Avec Ignorer la casse)
- Avec PosBM_Mickey974Modif_ => Trouvé : 6 fois, Mis : 171 ms dont 15 ms uniquement pour les appels à PosBM_Mickey974Modif
Tant pis si ça ralentit un peut les recherches mais 500 millisecondes pour 1000000 recherches c'est supportable si on ne veut pas être enquiquiné avec les accents, les majuscules et les minuscules.
Mais on peut également envisager de n'utiliser PosBM_Mickey974Modif_ que pour des recherches qui distinguent les Majuscules des minuscules et de créer une variante qu'on n'utilise que pour des recherches qui Ignorent ces différences.
Cela donnerait deux routine qui pédaleraient à la même vitesse puisque dans les deux cas l'initialisation de la SkipTable s'effectue avant les boucles d'appel.
En tous cas je vais choisir cette dernière solution.
>> "J'ai passé un WE ensoleillé au grand air sur le toit de ma maison pour y enlever la mousse!"
Entre les mousses et la tondeuse à gazon y a de quoi s'occuper (lol)
>> "Essayez ce test (je ne l'ai pas fait):
initialisez la table par défaut initBMH_sauts('')
puis utilisez la avec le test d'un mot (sans initialisation)?
Normalement c'est bon? (a petits pas)" :
Oui c'est bon, j'ai testé : tous les sauts sont à 1 : ça évite les plantages si on oublie d'initialiser la table mais avec des sauts de 1 on perd tout l'intérêt du Boyer-Moore.
Il serait peut-être plus simple de prévoir un if BMH_sauts[chr(0)]=1 then showmessage('Initialiser la table des sauts sinon ça va ramer') qui serait déclenché par un appel à PosBM_Mickey974Modif__()
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 15 juin 2015 à 13:04
Bonjour,
J'ai passé un WE ensoleillé au grand air sur le toit de ma maison pour y enlever la mousse!
Essayez ce test (je ne l'ai pas fait):
initialisez la table par défaut initBMH_sauts('')
puis utilisez la avec le test d'un mot (sans initialisation)?
Normalement c'est bon? (a petits pas)
J'ai remis un peu d'ordre dans nos échanges (il était temps), je placerai le tout dans une unité POaSm, en voici le début.
Pour la suite il me reste quelques vérifications à faire sur la pertinence des progs
à prendre comme modèle avant de sauter dessus à petits pas!
//-----------------------pas d'appel direct de ces procedures------------------ procedure __initBMH_sauts;{(Const SubStr : string; var TS : TBMH_sauts);} register; { EAX=ptr(SubSTR) EDX=ptr(TS)}
ASM // PUSH EBP MOV EBP,ESP EBP entrée=EBP+4 // LEA EDX,BMH_sauts //A SUPPRIMER SI TS EST PASSE EN PARAMETRE AND EAX,EAX //subSTR vide ? JNZ @leizh MOV EAX,$01010101 //la table BMH devient force brute MOV ECX,type TBMH_sauts SHR ECX,2 //ECX/4 @Rodellet: //charge table de 1 MOV [EDX],EAX ADD EDX,4 DEC ECX JNZ @Rodellet JMP @Kenavo //vers sortie @leizh: //suite avec subStr <> '' PUSH ESI //ESI = ptr(SubSTR) MOV ESI,EAX PUSH EDI MOV EDI,EDX //EDI = ptr(TS) ou TBMH_sauts MOV EDX,[ESI-4] //EDX = length(substr) PUSH EDX AND DH,DH JZ @Lamm1 XOR DL,DL //length(SubSTR) > 255 donc 255 DEC DL @Lamm1: MOV DH,DL MOV AX,DX BSWAP EAX MOV AX,DX //4 octets de length dans EAX MOV ECX,type TBMH_sauts SHR ECX,2 //ECX/4 PUSH EDI CLD //eteind direction donc incrémentation REP STOSD // EAX->[EDI] EDI+4 ECX+1 ECX=0=fin POP EDI POP EDX //fin remplissage de length(SubStr) DEC EDX //length-1 JZ @Lamm2 // 1 char = fin XOR ECX,ECX @Rodellet2: MOV AX,DX AND AH,AH JZ @Lamm //length-pos < 256 XOR AL,AL DEC AL @Lamm: MOV CL,BYTE ptr[ESI] //char MOV BYTE ptr[EDI+ECX],AL //TS[charN]=length(STR)-pos INC ESI DEC EDX //length(str)-pos JNZ @Rodellet2 @Lamm2: POP EDI POP ESI @Kenavo: end; //POP EBP RET N
//end--------------------pas d'appel direct de ces procedures------------------
procedure initBMH_sauts(Const SubStr : string; var TS : TBMH_sauts); register; overload; begin __initBMH_sauts; end;
>> "...la table de sauts peut être initialisée par défaut comme suit : initBMH_sauts(''); à placer dans INITIALIZATION ce qui permet de ne pas planter la machine en cas de mauvaise utilisation." :
OK c'est prudent.
>> "Dans ce cas l'algo devient 'force brute' et peut s'utiliser comme tel pour des mots et phrases courtes" :.
Non car si on initialise uniquement avec initBMH_sauts('') c'est à dire avec LenSub = 0 tous les sauts seront nuls donc la recherche ne fonctionnera pas et se comportera comme une boucle sans fin.
>> Par contre comme la création de la table des sauts est 2 fois plus rapide en ASM qu'en Pascal il ne resterait plus qu'à convertir également en ASM la function PosBM_Mickey974Modif__(const Mot, Texte: string; var Depuis: integer): integer;
Réponse à votre message de 17 heures 03 du 12 juin 2015 relatif à votre version ASM de la fabrique de table de sauts :
OK en ASM la création de la table des sauts est 2 fois plus rapide :
{A} initBMH Nombre de tests : 1000000 GetTickCount : 47
{B} initSkip2 Nombre de tests : 1000000 GetTickCount:78
Nombre de tests d'avance de {A} par rapport a {B}:397436
Réponse à votre message de 16 heures 57 du 12 juin 2015
Il y a une embrouille dans :
type tSkip2 = array[char] of byte; var Skip2: tSkip2;
procedure InitSkip255(ASubStr: string); var LenSub, k, v: integer; begin LenSub := Length(ASubStr); if LenSub > 255 then v:=255 else v:=LenSub; FillChar(Skip2, 256, v); for k := 1 to Pred(LenSub) do begin v:=LenSub-k; if v > 255 then v:=255; Skip2[AnsiChar(ASubStr[k])] :=v; end; end;
procedure InitSkip2(ASubStr: string); var LenSub, k : integer; begin LenSub := Length(ASubStr); FillChar(Skip2, 256, LenSub); for k := 1 to Pred(LenSub) do begin Skip2[AnsiChar(ASubStr[k])] := Lensub-k; end; end;
InitSkip255 et InitSkip2 utilisent toutes deux tSkip2 = array[char] of byte; et dans InitSkip2 vous placez l'integer Lensub -k dans un byte.
En conséquence de ceci avec votre Mot de 258 caractères 'A' tous les sauts relatifs aux caractères autres que le 'A' sont réduits à 2 et 1 pour le 'A' vu le "tests initskip2" alors que le "tests initSkip255" affiche 255 pour tous les sauts relatifs aux caractères autres que le 'A'
Et comme les performances du Boyer-Moore augmentent lorsque la valeur des sauts augmentent votre test de vitesse en est complètement faussé.
Pour vous convaincre de cette erreur essayez donc ce bout de code :
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 12 juin 2015 à 17:35
RE Bonjour,
J'ai oublié un détail qui me semble intéressant : la table de sauts peut être initialisée par défaut comme suit : initBMH_sauts(''); à placer dans INITIALIZATION ce qui permet de ne pas planter la machine en cas de mauvaise utilisation. Dans ce cas l'algo devient 'force brute' et peut s'utiliser comme tel pour des mots et phrases courtes.
Salutations
Type TBMH_sauts = array[char] of Byte; var BMH_sauts : TBMH_sauts;
{la mise en place de (var TS : TBMH_sauts) en paramétre permet d'affecter plusieurs tables de sauts et de rechercher plusieurs mots dans le même texte, il faut impérativement supprimer la 1° ligne (LEA EDX,BMH_sauts). }
//type tSkip2 = array[char] of byte; //var Skip2: tSkip2;
procedure InitSkip2(ASubStr: string); //d'après PosBM_Mickey974 et modifié var LenSub, k, v: integer; begin LenSub := Length(ASubStr); if LenSub = 0 then Begin FillChar(BMH_sauts,256,1); exit; end; if LenSub > 255 then v:=255 else v:=LenSub; {A} FillChar(BMH_sauts, 256, v); {B} //FillChar(Skip2, 256, LenSub); // la version {B} peut planter si LenSub = 256 for k := 1 to Pred(LenSub) do begin v:=LenSub-k; if v > 255 then v:=255; BMH_sauts[AnsiChar(AsubSTR[k])] :=v; end; end;
procedure test(const st : string); var I,J : Integer; begin J:=length(st); writeln('tests initSkip2'); initSkip2(st); for I := 0 to pred(sizeof(BMH_sauts)) do if BMH_sauts[chr(I)] <> J then write('[',BMH_sauts[chr(I)],']') else write(BMH_sauts[chr(I)],' '); writeln; initBMH_sauts(st{,BMH_sauts}); writeln('tests initBMH_sauts'); for I := 0 to pred(sizeof(BMH_sauts)) do if BMH_sauts[chr(I)] <> J then write('[',BMH_sauts[chr(I)],']') else write(BMH_sauts[chr(I)],' '); writeln; readln; end;
var S : string; I,K:integer; T1,T2,GTC,RTC : longWord; begin // Insérer le code utilisateur ici S:=''; test(S); for i := 1 to 256 do S:=s+chr(I and $FF); test(s); s:='ABCDEFGHabcdefgh1234567890'; test(s);
//compétitions K:=1000000;
GTC:=GetTickCount; //64 For I := 1 to K do initBMH_sauts(s); RTC:=GetTickCount; writeln('{A} initBMH Nombre de tests : ',K,' GetTickCount:',RTC-GTC); T1:=RTC-GTC; GTC:=GetTickCount; //101 For I := 1 to K do initSkip2(s); RTC:=GetTickCount; writeln('{A} initSkip2 Nombre de tests : ',K,' GetTickCount:',RTC-GTC); T2:=RTC-GTC; writeln('Nombre de tests d''avance de {A} par rapport a {B}:',formatFloat('0',K*(T2-T1)/T2)); readln; end.
Les test donne 64 pour la version ASM et 101 pour la version Pascal
Salutations
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 12 juin 2015 à 16:57
Re Bonjour,
Il n'est pas nécessaire de faire une table d'integer.
pour les mots < 256 char cela ne sert à rien.
pour des mots > 255 c'est certainement peu courant.
Pour résoudre ce problème il faut prendre en compte la modif de InitSkip2(ASubStr: string) qui ne plante JAMAIS et accepte toutes longueurs de mot
Pour ilustrer ceci je vous joint un programme test:
il utilise InitSkip2(ASubStr: string) en version origine
InitSkip255(ASubStr: string); avec mes modifs.
J'ai mis une fabrique de chaine que n'aime pas BMH pour mettre le coin dans la faille.
ensuite 2 tests
avec table de sauts InitSkip255 , résultat 3035 (grâce au saut de 255)
avec table de sauts InitSkip2 , résultat 18397 (des sauts de 2)( 258 MOD 256)
Vous verrez l'état des tables dans le test.
Je ne sais que dire de plus devant ce constat
program PosBM_Mickey974Modif_A; {$APPTYPE CONSOLE} uses sysutils,windows; type tSkip2 = array[char] of byte; var Skip2: tSkip2;
procedure InitSkip255(ASubStr: string); var LenSub, k, v: integer; begin LenSub := Length(ASubStr); if LenSub > 255 then v:=255 else v:=LenSub; FillChar(Skip2, 256, v); for k := 1 to Pred(LenSub) do begin v:=LenSub-k; if v > 255 then v:=255; Skip2[AnsiChar(ASubStr[k])] :=v; end; end;
procedure InitSkip2(ASubStr: string); var LenSub, k : integer; begin LenSub := Length(ASubStr); FillChar(Skip2, 256, LenSub); for k := 1 to Pred(LenSub) do begin Skip2[AnsiChar(ASubStr[k])] := Lensub-k; end; end;
function PosBM_Mickey974Modif__(const Mot, Texte: string; var Depuis: integer): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer; begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if Texte[i] <> Mot[j] then begin Inc(k, skip2[AnsiChar(Texte[k])]); goto SuffixePasBon; end else begin Dec(j); Dec(i); if j > 0 then goto Boucler; end; Result := succ(i); Depuis:=Result+LM; EXIT; SuffixePasBon: end; Result := 0; Depuis:=1; end;
var M,T : string; I,J,D,DP,Duree:integer; GTC:LongInt;
procedure testskip2(const st : string); var I,J : Integer; begin J:=length(st); writeln('tests initSkip2'); initSkip2(st); for I := 0 to pred(sizeof(Skip2)) do if Skip2[chr(I)] <> J then write('[',Skip2[chr(I)],']') else write(skip2[chr(I)],' '); writeln; initSkip255(st); writeln('tests initSkip255'); for I := 0 to pred(sizeof(Skip2)) do if Skip2[chr(I)] <> J then write('[',Skip2[chr(I)],']') else write(Skip2[chr(I)],' '); writeln; readln; end;
procedure Fab_M_T; var I,L :integer; begin L:=258; //257 ici et le prog plante SetLength(M,L); fillchar(M[1],L,'J'); M[1]:='A'; SetLength(T,Pred(L)); fillchar(T[1],pred(L),'X'); T:=T+M; end;
begin // Insérer le code utilisateur ici Fab_M_T; //le plus pénalisant si possible? testSkip2(M); writeln('attendre la fin'); Duree:=1000000; initSkip2(M); DP:=1; //18397 GTC:=GetTickCount; for I := 1 to duree do PosBM_Mickey974Modif__(M,T,DP); writeln('initSkip2 : ',GetTickCount-GTC);
initSkip255(M); DP:=1; //380 GTC:=GetTickCount; for I := 1 to duree do PosBM_Mickey974Modif__(M,T,DP); writeln('initSkip255 : ',GetTickCount-GTC); writeln('fin'); readln; end.
Salutations
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 12 juin 2015 à 15:41
Bonjour,
Là je suis perdu!
en 48c vous trouvez 151587081, ce qui est impossible sur 1 octet?
vous ne pouvez trouver que 0..255?
Salutations
>> "Vous avez remarquez que InitSkip2 avec la modif {B} plante? ":
Bin oui, mais ça vient de la déclaration de type tSkip2 = array[char] of byte; qu'il convient de remplacer par type tSkip2 = array[char] of integer;
Mais votre modif {A} FillChar(Skip2, 256, v); donne des résultats incorrects dont voici un extrait :
Skip Piette --- 48 c : 0 saut 151587081 <= Faux 49 c : 1 saut 8 50 c : 2 saut 7 51 c : 3 saut 6 52 c : 4 saut 5 53 c : 5 saut 4 54 c : 6 saut 3 55 c : 7 saut 2 56 c : 8 saut 1 57 c : 9 saut 151587081 <= Faux
Alors qu'avec le code suivant :
type tSkip2 = array[char] of integer; var Skip2: tSkip2;
procedure InitSkip2(ASubStr: string); var LenSub, k: integer; unc: char; begin LenSub := Length(ASubStr); for unc := #0 to #255 do Skip2[unc] := LenSub; for k := 1 to Pred(LenSub) do Skip2[AnsiChar(ASubStr[k])] := LenSub - k; end;
... on a les résultats corrects suivants :
Skip2 --- 48 c : 0 saut 9 49 c : 1 saut 8 50 c : 2 saut 7 51 c : 3 saut 6 52 c : 4 saut 5 53 c : 5 saut 4 54 c : 6 saut 3 55 c : 7 saut 2 56 c : 8 saut 1 57 c : 9 saut 9
>> A propos de "..élargir la table à 2 octets va alourdir la lecture. " :
C'est le prix à payer si vous voulez utiliser la routine avec des LenSub > 255 mais le ralentissement est minime.
Cordialement, et à +.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 12 juin 2015 à 00:25
Bonsoir,
Vous avez remarquez que InitSkip2 avec la modif {B} plante? car présence de 0.
l'initialisation des sauts à lenSub peut être 0 car la table est sur 1 octet.
exemple pour 256 512 etc soit lenSub modulo 256.
élargir la table à 2 octets va alourdir la lecture.
je vais prendre connaissance de toutes vos remarques.
Salutations
Voici une variante créée à partir de PosBM_Mickey974Modif qui renvoie en un seul appel toutes les Positions des occurrences de Mot dans Texte à partir de Depuis et jusqu'à la fin de Texte
type TAOI = array of integer;
function OccPosBM_Mickey(const Mot, Texte: string; Depuis: integer; var Posit: TAOI): integer; // Result la Position du dernier Mot situé à partir de Depuis // La var Posit renvoie les Positions des autres occurrences // Le nombre d'occurences trouvées à partir de Depuis est donc length(Posit) // Avec Depuis = 1 on obtient le nombre total d'occurences du Mot dans Texte label SuffixePasBon, Boucler, OccSuiv; var i, j, k, LT, LM, occs: integer; begin LM := Length(Mot); LT := Length(Texte); occs := 0; SetLength(Posit, occs); OccSuiv: k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if Texte[i] <> Mot[j] then begin // Suffixe Pas OK on avance avec la SkipTable Inc(k, skip2[AnsiChar(Texte[k])]); goto SuffixePasBon; end else begin // Suffixe OK on recule pour comparer les caractères précédents Dec(j); Dec(i); if j > 0 then goto Boucler; // sinon si j = 0 on a trouvé une occurrence en i et EXIT end; Result := i; inc(occs); SetLength(Posit, occs); Posit[occs - 1] := i; if i + LM <= LT then begin Depuis := i + LM; goto OccSuiv; end else EXIT; SuffixePasBon: end; Result := 0; end;
Vous m'aviez demandé "Essayez de tester BmhStrPos_ dans les conditions ci dessus pour voir ?" et j'avais mal compris.
Voici les résultats comparatifs pour :recherche de 123456789 dans 012345678901234567890123456789012345678901234567890123456789123
Pour nb-Recherches = 800000 :
- Avec PosBM_Mickey974D => Trouvé : 6 fois, Mis : 405 ms dont 265 ms uniquement pour les appels à PosBM_Mickey974D
- Avec PosBM_Mickey974Modif => Trouvé : 6 fois, Mis : 125 ms dont 47 ms uniquement pour les appels à PosBM_Mickey974Modif
- Avec BMHStrPos_ => Trouvé : 6 fois, Mis : 1981 ms dont 1918 ms uniquement pour les appels à BMHStrPos_
Conclusion : on peut laisser tomber BMHStrPos_ et PosBM_Mickey974D.
GTC1 := GetTickCount; Mis := 0; for i := 1 to nbTours do begin Count := 0; Depuis := 1; GTC2 := GetTickCount; Po := PosBM_Mickey974D(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); while Po > 0 do begin inc(Count); Depuis := Po + LM + 1; if Depuis >= LT then break; GTC2 := GetTickCount; Po := PosBM_Mickey974D(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); end; end; Trace('Pour nb-Recherches = ' + intToStr(nbTours) + ' :'); Trace('Avec PosBM_Mickey974D => Trouvé : ' + intToStr(Count) + ' fois, Mis : ' + IntToStr(GetTickCount - GTC1) + ' ms dont ' + intToStr(Mis) + ' ms uniquement pour les appels à PosBM_Mickey974D');
GTC1 := GetTickCount; Mis := 0; InitSkip2(Mot);
for i := 1 to nbTours do begin Count := 0; Depuis := 1; GTC2 := GetTickCount; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); while Po > 0 do begin inc(Count); Depuis := Po + LM + 1; if Depuis >= LT then break; GTC2 := GetTickCount; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); end; end; Trace('Pour nb-Recherches = ' + intToStr(nbTours) + ' :'); Trace('Avec PosBM_Mickey974Modif => Trouvé : ' + intToStr(Count) + ' fois, Mis : ' + IntToStr(GetTickCount - GTC1) + ' ms dont ' + intToStr(Mis) + ' ms uniquement pour les appels à PosBM_Mickey974Modif');
GTC1 := GetTickCount; Mis := 0; D := 1; pText := pchar(Texte); for i := 1 to nbTours do begin Count := 0; GTC2 := GetTickCount; Poc := BMHStrPos_(pText, pchar(mot), D); Mis := Mis + (GetTickCount - GTC2); while Poc <> nil do begin inc(Count); GTC2 := GetTickCount; Poc := BMHStrPos_(pText, pchar(mot), D); Mis := Mis + (GetTickCount - GTC2); end; end; Trace('Avec BMHStrPos_ => Trouvé : ' + intToStr(Count) + ' fois, Mis : ' + IntToStr(GetTickCount - GTC1) + ' ms dont ' + intToStr(Mis) + ' ms uniquement pour les appels à BMHStrPos_'); end;
"-InitSkip2 :
Il y a 2 erreurs:
1°) erreur : il est possible d'avoir une table de saut avec des zéros et c'est l'enlacement fatal voir //----plante le prog avec l'option {B}--- dans le test
if LenSub > 255 then v:=255 else v:=LenSub; //****************modif
{A} FillChar(Skip2, 256, v);
{B} //FillChar(Skip2, 256, LenSub);
// la version {B} peut planter si LenSub = 256
2°) petite erreur si le mot à plus de 255 char la table de saut reçoit au delà de 255
zéro ou position du char modulo 256. ce qui plante ou fait des petits sauts."
Sur 1° : FillChar doit initialiser toutes les valeurs des sauts dans un premier temps à LenSub ce qui fait qu'aucun saut ne peut être 0 si LenSub <> 0 et ceci concerne avant tout tous les caractères qui ne figurent pas dans la SubString
et dans un deuxième temps, pour les caractères qui figurent dans la Substring on corrige les sauts avec for k := 1 to Pred(LenSub) do Skip2[AnsiChar(ASubStr[k])] := LenSub - k; et là aussi la plus petite valeur de saut est 1 et jamais 0
Donc sur 1° je ne comprends pas ce que vous trouvez comme erreur.
Sur 2° : Si la SubString à plus de 255 caractères c'est forcément qu'elle contient un certain nombre de caractères identiques.
Et quelle que soit LenSub s'il y figure des caractère identiques comme le 'u' de Trucmuche le saut correspondant au 'u' est ici de 3, distance qui sépare le 'u' le plus proche du 'e' terminal, donc là aussi je ne comprends pas l'erreur que vous signalez.
Par contre vos remarques tombent à pic car il y a quand même une erreur :
Si LenSub > 255 alors tSkip2 ne peut être un array[char] of byte; mais un array d'integer :
type tSkip2 = array[char] of integer; var Skip2: tSkip2;
procedure InitSkip2(ASubStr: string); var LenSub, k: integer; unc: char; begin LenSub := Length(ASubStr); for unc := #0 to #255 do Skip2[unc] := LenSub; for k := 1 to Pred(LenSub) do Skip2[AnsiChar(ASubStr[k])] := LenSub - k; end;
-InitSkip2:
Il y a 2 erreurs:
1°) erreur : il est possible d'avoir une table de saut avec des zéros et c'est l'enlacement fatal voir //----plante le prog avec l'option {B}--- dans le test
2°) petite erreur si le mot à plus de 255 char la table de saut reçoit au dela de 255
zéro ou position du char modulo 256. ce qui plante ou fait des petits sauts.
PosBM_Mickey974Modif__:
la valeur de sortie est inférieure de 1.
si pas trouvé la valeur retournée est -1 je l'ai mise à zéro (comme pos delphi)
J'ai implanté Depuis pour trouver toutes les occurrences dans le texte.
voila:
program PosBM_Mickey974Modif_; {$APPTYPE CONSOLE} uses sysutils; type tSkip2 = array[char] of byte; var Skip2: tSkip2;
procedure InitSkip2(ASubStr: string); var LenSub, k, v: integer; begin LenSub := Length(ASubStr); if LenSub > 255 then v:=255 else v:=LenSub; //****************modif
{A} FillChar(Skip2, 256, v);
{B} //FillChar(Skip2, 256, LenSub);
// la version {B} peut planter si LenSub = 256
for k := 1 to Pred(LenSub) do begin v:=LenSub-k; if v > 255 then v:=255; //*******modif grands sauts Skip2[AnsiChar(ASubStr[k])] :=v; //Lensub-k; end; end;
function PosBM_Mickey974Modif__(const Mot, Texte: string; var Depuis: integer): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer; begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if Texte[i] <> Mot[j] then begin // Suffixe Pas Ok on avance avec la Skip-table Inc(k, skip2[AnsiChar(Texte[k])]); goto SuffixePasBon; end else begin // Suffixe Ok on recule pour comparer les caractères précédents Dec(j); Dec(i); if j > 0 then goto Boucler; // sinon si j = 0 on a trouvé une occurrence en i et EXIT end; Result := succ(i); //**************modification ici i est remplacé par succ(i) Depuis:=Result+LM; EXIT; SuffixePasBon: end; Result := 0; Depuis:=1; end;
var SubStr,Scible : string; J,D:integer;
procedure voirSub(Const S : string); var I : integer; begin writeln(S); initSkip2(S); for I := 1 to length(S) do writeln(S[I],' : ',Skip2[AnsiChar(S[I])]); readln; end;
begin // Insérer le code utilisateur ici
//----plante le prog avec l'option {B}----------------------- SubStr:='AZERTYUIOPQSDFGH'; for J := 1 to 4 do SubStr:=SubStr+SubStr; //SubSTR:=SubSTR; Scible:=SubStr; Scible[256]:='X'; Scible:=Scible+'W'; initSkip2(SubStr); D:=1; writeln('lenSubSTR : ',length(SubSTR),' len Scible : ',length(Scible)); writeln('trouve ',PosBM_Mickey974Modif__(SubStr,Scible,D)); writeln('---------------------------------------'); //end -plante le prg sans la modif de initSkip2-----------------------
Substr:=substr+substr+SubStr+SubSTR; Scible:='aa'+Substr; Scible:=Scible+Scible+Scible+Scible+Scible+Scible; initSkip2(SubStr); D:=1; writeln('lenSubSTR : ',length(SubSTR),' len Scible : ',length(Scible)); Repeat J:=PosBM_Mickey974Modif__(SubStr,Scible,D); writeln('pos de SubSTR : ',J,' dans Scible retour:',D); Until j = 0;
//------modif de depuis pour trouver toutes les occurrences------------------- SuBstr:='aze'; Scible:='13aze12aze12aze456azeazeaz'; initSkip2(SubStr); D:=1; writeln('lenSubSTR : ',length(SubSTR),' len Scible : ',length(Scible)); repeat j:=PosBM_Mickey974Modif__(SubStr,Scible,D); writeln('pos de ',SubSTR,' : ',J,' dans ',Scible,' retour:',D); Until j = 0; writeln('---------------------------------------'); //end---modif de depuis pour trouver toutes les occurrences------------------- readln; end.
>> "Essayez de tester BmhStrPos_ dans les conditions ci dessus pour voir?":
Si je le teste dans vos conditions on ne pourra pas comparer avec les autres.
>> "Je pense que le plus rapide( en m s) est de modifier posKR en 2 morceaux comme PosBm_Mickey974Modif et l'ajout de 'depuis' Le mieux placé pour cela est le créateur de posKR. Autrement je me lance dans le vide sidéral code." :
Sinon vous pouvez toujours convertir le code ci-dessous en PChar.
J'ai essayé à plusieurs reprises de convertir ce code en PChar pour s'approcher de la vélocité de l'ASM mais je me suis planté à chaque fois à cause de bugs incompréhensibles.
type tSkip2 = array[char] of byte; var Skip2: tSkip2;
procedure InitSkip2(ASubStr: string); // Initialisation de la Skip-table var LenSub, k: integer; begin LenSub := Length(ASubStr); FillChar(Skip2, 256, Lensub); for k := 1 to Pred(LenSub) do Skip2[AnsiChar(ASubStr[k])] := LenSub - k; end;
function PosBM_Mickey974Modif(const Mot, Texte: string; Depuis: integer): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer; begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if Texte[i] <> Mot[j] then begin // Suffixe Pas Ok on avance avec les sauts de la Skip-table Inc(k, skip2[AnsiChar(Texte[k])]); goto SuffixePasBon; end else begin // Suffixe Ok on recule pour comparer les caractères précédents Dec(j); Dec(i); if j > 0 then goto Boucler; // sinon si j = 0 on a trouvé une occurrence en i et EXIT end; Result := i; EXIT; SuffixePasBon: end; Result := -1; end;
Bonjour,
Essayez de tester BmhStrPos_ dans les conditions ci dessus pour voir?
Edit=en seconde lecture je viens de comprendre que 'votre code du 9juin' est en fait le votre que j'ai bricolé, alors que je pensais a mon code ASM, d'où ma confusion.
Je pense que le plus rapide( en m s) est de modifier posKR en 2 morceaux comme PosBm_Mickey974Modif et l'ajout de 'depuis'
Le mieux placé pour cela est le créateur de posKR .
Un bon complément de tuto pour moi.
Autrement je me lance dans le vide sidéral code.
Salutations.
Pour illustrer le gain de vitesse obtenu en créant la Skip-Table une fois pour toutes avant les appels répétitifs aux routines Boyer-Moore voici les résultats d'un test comparatif obtenu cette fois-ci sans colorier le mots du RichEdit :
Recherche de 123456789 dans 012345678901234567890123456789012345678901234567890123456789123
Pour nb-Recherches = 800000 :
- Avec PosBM_Mickey974D => Trouvé : 6 fois, Mis : 421 ms dont 155 ms uniquement pour les appels à PosBM_Mickey974D Pour nb-Recherches = 800000 :
- Avec PosBM_Mickey974Modif => Trouvé : 6 fois, Mis : 125 ms dont 61 ms uniquement pour les appels à PosBM_Mickey974Modif
Dans PosBM_Mickey974D la Skip-table est re-crée lors de chacun de 800000 appels tandis que les 800000 appels à PosBM_Mickey974Modif la Skip-table n'est crée qu'une seule fois avant les appels
GTC1 := GetTickCount; Mis := 0; for i := 1 to nbTours do begin Count := 0; Depuis := 1; GTC2 := GetTickCount; Po := PosBM_Mickey974D(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); while Po > 0 do begin inc(Count); Depuis := Po + LM + 1; if Depuis >= LT then break; GTC2 := GetTickCount; Po := PosBM_Mickey974D(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); end; end; Trace('Pour nb-Recherches = ' + intToStr(nbTours) + ' :'); Trace('Avec PosBM_Mickey974D => Trouvé : ' + intToStr(Count) + ' fois, Mis : ' + IntToStr(GetTickCount - GTC1) + ' ms dont ' + intToStr(Mis) + ' ms uniquement pour les appels à PosBM_Mickey974D');
GTC1 := GetTickCount; Mis := 0; InitSkip2(Mot);
for i := 1 to nbTours do begin Count := 0; Depuis := 1; GTC2 := GetTickCount; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); while Po > 0 do begin inc(Count); Depuis := Po + LM + 1; if Depuis >= LT then break; GTC2 := GetTickCount; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); Mis := Mis + (GetTickCount - GTC2); end; end; Trace('Pour nb-Recherches = ' + intToStr(nbTours) + ' :'); Trace('Avec PosBM_Mickey974Modif => Trouvé : ' + intToStr(Count) + ' fois, Mis : ' + IntToStr(GetTickCount - GTC1) + ' ms dont ' + intToStr(Mis) + ' ms uniquement pour les appels à PosBM_Mickey974Modif'); end;
Peut-être qu'une variante PChar ou ASM de PosBM_Mickey974Modif serait plus véloce que le code Pascal actuel.
>> "Je ne vois pas comment mettre le prog comme vous le faites donc recours au copié collé ci dessous" :
Cliquer sur <> juste ci-dessus à droite là où se trouve B I S <> cela place les balises code dans cette lucarne ensuite insérer votre code entre les <>
.
>> "J'ai modifié un peu BMHStrPos en y ajoutant Depuis et le dépannage de Cirec. vous pourrez le mettre en piste pour se mesurer avec les 2 précédents concurrents et voir comment se place votre code." :
Voici les résultats pour la recherche de 123456789 dix mille fois dans
012345678901234567890123456789012345678901234567890123456789123
- Avec PosBM_Mickey974Modif => Trouvé : 6 fois, Mis : 4712 ms pour nb-Recherches = 10000
- Avec PosKR => Trouvé : 6 fois : Mis : 4820 ms pour nb-Recherches = 10000
- Avec votre code du 9juin => Trouvé : 6 fois, Mis : 4789 ms pour nb-Recherches = 10000
Mais j'ai fait ce test comme suit pour vérifier en même temps par coloriage des mots dans le RichEdit 'Re' que la position des occurrences trouvées est correcte donc les 3 durées d'exécution incluent ces coloriages :
procedure TForm1.bPiette9juinClick(Sender: TObject); var Poc, pText: PChar; nbTours: longword; begin
Mot := '123456789'; Texte := '012345678901234567890123456789012345678901234567890123456789123';
//compétition D := 1; GTC := GetTickCount; nbTours:=10000; pText := pchar(Texte); with RE do begin lines.BeginUpdate; for I := 1 to nbTours do begin N := 0; Poc := BMHStrPos_(pText, pchar(mot), D); while Poc <> nil do begin inc(N); SelStart := Poc - pText; SelLength := length(Mot); SelAttributes.Style := [fsBold]; SelAttributes.Color := clBlue; Poc := BMHStrPos_(pText, pchar(mot), D); end; //break; end; lines.EndUpdate; end; Trace('Avec Piette9juin => Trouvé : ' + intToStr(N)+' fois, Mis : ' + intToStr(GetTickCount - GTC)+' ms pour nb-Recherches = '+IntToStr(nbTours)); end;
On remarque que les durées d'exécution (PosBM_Mickey974Modif : 4712 ms, PosKR : 4820 ms, et votre code du 9juin : 4789 ms) se tiennent dans un mouchoir de poche, cependant :
- si PosBM_Mickey974Modif qui n'est ni en PChar, ni en ASM est un peu plus rapide que les deux autres c'est certainement parce que j'initialise la Skip-Table une fois pour toutes avant d'appeler la routine PosBM_Mickey974 dans les boucles car si on cherche le même Mot dans un nombre N de textes différents il est inutile de re-créer la Skip-Table N fois puisque son contenu ne dépend que du Mot à trouver.
- et si PosKR qui est en ASM est la plus lente c'est pour deux raisons : 1) comme on ne peut lui passer le paramètre 'Depuis' je raccourcis la chaîne du texte avec un Copy pour trouver chaque occurrence suivante, et 2) elle re-crée la Skip-Table lors de chaque appel.
>>"D'autre part je suis allé visiter le site des fidèles et regarder posKR.
Cela m'a permis de mieux comprendre le fonctionnement de la table des sots" :
Bin oui, dans la Skip-table les valeurs de tous les sauts sont égaux à length(Mot) pour tous les caractères qui ne figurent pas dans le Mot c'est ce qui favorise l'avance rapide, et pour ceux qui y figurent la valeur du saut dépend de sa position dans le Mot et sa longueur.
Exemple recherche de :
Delphi OxiDelphixyzd < dans le texte
Comme sous le i on a le l la valeur du saut est égale à 3 pour positionner le mot Delphi exactement à la place de celui du texte.
Bonsoir,
Cirec minute est plus rapide que mon peugeot minute pour le dépannage, chapeau bas.
J'ai modifié un peu BMHStrPos en y ajoutant Depuis et le dépannage de Cirec.
vous pourrez le mettre en piste pour se mesurer avec les 2 précédents concurrents et voir comment se place votre code.
Je ne vois pas comment mettre le prog comme vous le faites donc recours au copié collé ci dessous.
D'autre part je suis allé visiter le site des fidèles et regarder posKR.
Cela m'a permis de mieux comprendre le fonctionnement de la table des sots.
Voici le prog:
program BMHStrPos; {$APPTYPE CONSOLE} uses sysutils, windows;
function BMHStrPos_(Const pTex, pMot: PChar; var Depuis : integer): PChar; // BMHStrPos à la façon Boyer-Moore-Horspool var it, im: Integer; // Indexes sur Texte et Mot LC, LM: Integer; // Longueur de pTex iav: Integer; // Indexe d'avancement pit, pim, pTexDepuis: PAnsiChar; // Indexes PChar ok: boolean;
function max32(v1,v2: integer): integer; register; begin // if v1 > v2 then Result:=v1 else Result:=v2; asm //EAX=v1 EDX=v2 CMP EAX,EDX JG @x //EAX > EDX MOV EAX,EDX @x: end; //EAX=result end;
begin Result := nil; LC := Length(pTex)-Depuis+1; PtexDepuis:=Ptex+Depuis-1; LM := Length(pMot); iav := LM; while iav <= LC do begin it := iav; im := LM; ok := true; while ok do begin pit := pTexDepuis + it - 1; pim := pMot + im - 1; if pit^ = pim^ then begin dec(im); dec(it); end else ok := false; if im = 0 then begin RESULT := pit; Depuis:=pit-pTex+LM+1; EXIT; end; end; // while ok ... // inc(iav, max32(LM - im,1)); //solutions au choix? IncAvecMax(iav,LM - im,1); end; // while iav <= LC Depuis:=1; end;
begin // Insérer le code utilisateur ici Mot := '123456789'; Texte := '012345678901234567890123456789012345678901234567890123456789123'; D:=1; Repeat R:=BMHStrPos_(pchar(Texte),pchar(mot),D); if R <> Nil then writeln(R); Until R = Nil;
//compétition D:=1; N:=0; GTC := GetTickCount;
for I := 1 to 10000 do while BMHStrPos_(pchar(Texte),pchar(mot),D)<> Nil do inc(N);
writeln('Nombre de tests : ',N,' GetTickCount:',GetTickCount-GTC); readln; end.
Dans la précipitation j'avais oublié de supprimer un sms('break') ainsi qu'un break dans le code d'utilisation de PosBM_Mickey974Modif(Mot, Texte, Depuis) : mille excuses, voici le code corrigé :
procedure TForm1.bPosBM_Mickey974ModifieClick(Sender: TObject); var Mot, Texte, TR: string; LM, LT, Depuis, nbTours, Po: integer; skip: tSkip2; GTC, Count : LongWord; begin Texte := trim(RE.Text); // RE = un RichEdit Mot := trim(edMot.text); LM := length(Mot); LT := length(Texte); GTC := GetTickCount; nbTours:=10000; InitSkip2(Mot); with RE do begin lines.BeginUpdate; for i := 1 to nbTours do begin Count := 0; Depuis := 1; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); while Po > 0 do begin inc(Count); SelStart := Po; SelLength := LM; SelAttributes.Style := [fsBold]; SelAttributes.Color := clFuchsia; Depuis := Po + LM + 1; if Depuis >= LT then break; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); end; end; lines.EndUpdate; end; Trace('Trouvé : ' + intToStr(Count) + ' fois'); // Trace = RichEdit.lines.add(string); Trace('Avec PosBM_Mickey974 Modifié : Mis : ' + IntToStr(GetTickCount - GTC) + ' ms pour nb-Recherches = ' + intToStr(nbTours)); end;
>> Cirec : "Ex. pour la fonction Pos pas moins de 19 variantes sont testées" :
Là, du coup je suis submergé à mon tour !!!
Mais j'ai quand même téléchargé PosBV560.zip : merci
>> Piette, vous dites "La fonction a été mise 2 fois en échec sur 5 tests (?). " :
J'ai également remarqué qu'elle déraillait parfois.
Par contre la solution de mon message du 7 juin 2015 à 14:21 qui utilise la routine en ASM de KR85 fonctionne bien en récupérant la routine de KR85 ici : http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=82390.
En plus de ceci j'ai également modifié la routine de Mickey974 que vous pouvez voir également sur le site de Phidels de façon à permettre des recherches à partir d'une position 'Depuis' et comme elle n'utilise pas d'ASM je vous la passe :
type tSkip2 = array[char] of byte; var Skip2: tSkip2;
procedure InitSkip2(ASubStr: string); var LenSub, k: integer; begin LenSub := Length(ASubStr); FillChar(Skip2, 256, Lensub); for k := 1 to Pred(LenSub) do Skip2[AnsiChar(ASubStr[k])] := LenSub - k; end;
function PosBM_Mickey974Modif(const Mot, Texte: string; Depuis: integer): integer; label SuffixePasBon, Boucler; var i, j, k, LT, LM: integer; begin LM := Length(Mot); LT := Length(Texte); k := Depuis - 1 + LM; while (k <= LT) do begin i := k; j := LM; Boucler: if Texte[i] <> Mot[j] then begin // Suffixe Pas Ok on avance avec la Skip-table Inc(k, skip2[AnsiChar(Texte[k])]); goto SuffixePasBon; end else begin // Suffixe Ok on recule pour comparer les caractères précédents Dec(j); Dec(i); if j > 0 then goto Boucler; // sinon si j = 0 on a trouvé une occurrence en i et EXIT end; Result := i; EXIT; SuffixePasBon: end; Result := -1; end;
Les principales différences avec la source d'origine ont été :
- d'initialiser une fois pour toutes la Skip-Table (qui ne dépend que de la SubString) avec la routine procedure InitSkip2(ASubStr: string) ce qui évite de ré-initialiser cette table lors de chaque appel de la function PosBM_Mickey974Modif(.)
- et de lui passer en en plus le paramètre 'Depuis'.
(Comme je suis nul en ASM je n'ai donc pas fait la même chose avec la routine de KR85 et la solution de mon message du 7 juin 2015 à 14:21 ne repose donc que sur un pis-aller qui consiste à appeler la routine de KR85 dans une boucle dans laquelle je raccourcis la longueur du texte-cible, mais du coup on ajoute un Copy et en plus la skip-table est réinitialisée à chaque appel).
// Pour utiliser PosBM_Mickey974Modif(...,Depuis) :
procedure TForm1.bPosBM_Mickey974ModifieClick(Sender: TObject); var Mot, Texte, TR: string; LM, LT, Depuis: integer; skip: tSkip2; begin Texte := trim(RE.Text); Mot := trim(edMot.text); LM := length(Mot); LT := length(Texte); GTC := GetTickCount; InitSkip2(Mot); with RE do begin lines.BeginUpdate; for i := 1 to nbTours do begin Count := 0; Depuis := 1; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); while Po > 0 do begin inc(Count); SelStart := Po; SelLength := LM; SelAttributes.Style := [fsBold]; SelAttributes.Color := clFuchsia; Depuis := Po + LM + 1; if Depuis >= LT then begin sms('break'); break; end; Po := PosBM_Mickey974Modif(Mot, Texte, Depuis); end; break; end; lines.EndUpdate; end; Trace('Trouvé : ' + intToStr(Count) + ' fois'); Trace('Avec PosBM_Mickey974 Modifié : Mis : ' + IntToStr(GetTickCount - GTC) + ' ms pour nb-Recherches = ' + intToStr(nbTours)); end;
Cordialement, et à +.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 8 juin 2015 à 16:52
Ceci semble répondre au problème:
program Project4;
{$APPTYPE CONSOLE}
uses SysUtils, Math; { ******** ajouté pour la fonction Max }
function BMHStrPos(const pTex, pMot: PChar): PChar; // StrPos à la façon Boyer-Moore-Horspool var it, im: Integer; // Indexes sur Texte et Mot LC, LM: Integer; // Longueur de pTex iav: Integer; // Indexe d'avancement pit, pim: PAnsiChar; // Indexes PChar ok: boolean; begin Result := nil; LC := Length(pTex); LM := Length(pMot); iav := LM; while iav <= LC do begin it := iav; im := LM; ok := true; while ok do begin pit := pTex + it - 1; pim := pMot + im - 1; if pit^ = pim^ then begin dec(im); dec(it); end else ok := false; if im = 0 then begin RESULT := pit; EXIT; end; end; // while ok ... inc(iav, Max(LM - im, 1)); { ********* Correction ici ******** } end; // while iav <= LC end;
procedure testBM(Const pTex, pMot: PChar); var R : Pchar; begin R:=BMHStrPos(pTex,pMot); // c'est la function que vous m'avez prêté if R = NIL then R:='???'; writeln('[',pMot,'] ---> [',pTex,'] = [',R,']'); end;
begin // Insérer le code utilisateur ici testBM('-11-110','-11'); testBM('111-110','-11'); testBM('1111-110','-11'); //------> Résultat=Ok testBM('11111-110','-11');//------> Résultat=Ok testBM('111111-110','-11'); readln; end.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 8 juin 2015 à 14:48
Bonjour,
Vous me fournissez beaucoup de lecture je suis submergé! Merci
Après révision de mon tuto j'ai essayé de comprendre l'algo, que j'ai trouvé plus compliqué que prévu (par moi).
Ensuite j'ai fait quelques test pour voir les réactions, en utilisant ceci:
procedure testBM(Const pTex, pMot: PChar);
var R : Pchar;
begin
R:=StrPos(pTex,pMot); // c'est la function que vous m'avez prêté
if R = NIL then R:='???';
writeln('[',pMot,'] ---> [',pTex,'] = [',R,']');
end;
begin
// Insérer le code utilisateur ici
testBM('-11-110','-11');
testBM('111-110','-11');
testBM('1111-110','-11'); //------> Résultat=NIL ????
testBM('11111-110','-11');//------> Résultat=NIL ????
testBM('111111-110','-11');
readln;
end.
La fonction a été mise 2 fois en échec sur 5 tests (?).
Je ne sais pas trop pourquoi, comme vous maitrisez cela bien plus que moi je vous laisse regarder avant d'essayer en ASM
A bientôt.
Salutations.
Cirec
Messages postés3833Date d'inscriptionvendredi 23 juillet 2004StatutModérateurDernière intervention18 septembre 202250 8 juin 2015 à 14:45
Salut tout le monde,
je constate que vous avez fini par trouver la balise de code ^^
trêve de plaisanteries ... je suis très content de voir qu'il y a encore des membres actifs et qui osent se lancer dans de type de challenge ;)
enfin un peu de vie sur CS_Delphi ... rien que pour ça je vous dis Bravo et Merci.
juste pour information: les fonctions Pos & PosEx de Delphi (et bien d'autres encore) sont issues du FastCode Challenge Project sur la gauche de la page vous y trouverez la liste des fonctions Delphi traitées dans ce challenge et bien sûr le plus important, les sources
- Ex. pour la fonction Pos pas moins de 19 variantes sont testées
et logiquement tous les vainqueurs ont intégrés la RTL de Delphi
... il y a encore d'autres choses à voir sur le site ... ;)
bien sûr tout ceci n'empêche pas de trouver ou d'explorer d'autres pistes ... bien au contraire
on l'a tous fait ... rien de mieux pour apprendre et à tous niveaux
Comme KR85 m'a rappelé que le Boyer-Moore a été implémenté de plusieurs façons et en ASM ici : http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=82390
mais avec des fonctions du type POSXY(SubStr, Str : string):integer; donc sans passage de votre paramètre 'Depuis' je vous signale que l'on peut néanmoins utiliser la function POSKR(SubStr, Str : string):integer; register; de KR85 dans une boucle pour trouver les positions des occurrences successives en raccourcissant la Str cible avent chaque appel suivant :
procedure TForm1.bPosKRClick(Sender: TObject); var Mot, Texte, TR: string; LM, Po, Delta, nbTours: integer; GTC : longword; begin Texte := trim(RE.Text); nbTours := 10000; Mot := trim(edMot.text); LM := length(Mot); GTC := GetTickCount; with RE do begin // RE est un RichEdit lines.BeginUpdate; for i := 1 to nbTours do begin Count := 0; Delta := 1; Po := PosKR(Mot, Texte); while Po > 0 do begin inc(Count); SelStart := Po + Delta - 2; SelLength := LM; SelAttributes.Style := [fsBold]; SelAttributes.Color := clFuchsia; // Recherche de la position de l'occurrence suivante : Delta := Delta + Po + LM; TR := Copy(Texte, Delta, MaxInt); if length(TR)<LM then break; Po := PosKR(Mot, TR); end; end; lines.EndUpdate; end; Trace('Trouvé : ' + intToStr(Count) + ' fois'); // Trace = RichEdit.lines.Add(string); Trace('Avec PosKR : Mis : ' + IntToStr(GetTickCount - GTC) + ' ms pour nb-Recherches = ' + intToStr(nbTours)); end;
Résultats pour :
Mot := '123456789'
Texte := '012345678901234567890123456789012345678901234567890123456789123'
Trouvé : 6 fois Avec PosKR : Mis : 4789 ms pour nb-Recherches = 10000
Trouvé : 6 fois Avec Pos ASM de Piette : Mis : 6349 ms pour nb-Recherches = 10000 (1,32 fois plus lente)
Voici à toutes fins utiles une version basique sans PChar d'une StrPos à la mode Boyer-Moore simplifié :
function StrPosBMH(const Mot, Text: string; var Depuis: integer): integer; label AGrandsPas; var LM, LT, it, im: integer; cSuff: Char; begin Result := 0; if (Mot = '') or (Text = '') then EXIT; LM := length(Mot); LT := length(Text); cSuff := Mot[Lm]; if (Depuis + LM > LT) then EXIT; if (Depuis <= 0) or (Depuis > LT - LM) then Depuis := 1; // Amorçage : it := Depuis + LM - 1; while (it < LT) and (Text[it] <> cSuff) do inc(it); if it > LT then EXIT;
AGrandsPas: // Avance rapide : while (it < LT) and (Text[it] <> cSuff) do begin Inc(Depuis, LM); it := Depuis + LM - 1; end; if it >= LT then EXIT;
for im := LM - 1 downto 1 do begin // marche à reculons dec(it); if Text[it] <> Mot[im] then begin Depuis := Depuis + LM - 1; it := Depuis + LM - 1; goto AGrandsPas; end else if im = 1 then begin Result := it; EXIT; end; end; end;
On trouve sur le net des variantes de Boyer-Moore plus compliquées qui utilisent des SkipTables.
>> "Il est évident que votre proposition sera plus rapide à l'exécution" :
C'est bien ce que je pense car.cela évite de ralentir avec des tests inutiles.
Cela fonctionne comme un pochoir.dans lequel on perce la SubString et qu'on place sur le Texte à la position Depuis et tant qu'on ne voit pas au travers du dernier caractère du pochoir un caractère du Texte qui lui est égal on déplace le pochoir d'un pas égal à length(SubString) donc une avance à grands pas.
Par contre dès qu'il y a égalité sur le dernier caractère du pochoir on passe dans une deuxième boucle où l'on marche à reculons pour vérifier si l'égalité se propage jusqu'au premier caractère de pochoir et :
- si oui on a trouvé la position de la première occurrence et la fonction retourne
cette position,
- si non on déplace le pochoir d'un pas égal à length(SubString) et on passe
dans la première boucle dans laquelle on ne teste que le dernier caractère.
>> "Je révise mon tuto et vais reprendre le code. Je trouve qu'il est plus facile en ASM de tout reconstruire plutôt que de modifier." :
C'est souvent vrai aussi dans les autres cas.
>> "Dès que ce sera au point je reviens vers vous" :
OK, merci.
.
>> "Merci pour votre algo que je ne connaissais pas" :
De rien et en plus l'algo ne m'appartient pas je me suis contenté d'en faire une version PChar.en simplifiant à l'extrême.
Bonjour,
b, c'est étrange bien sûr mais j'ai eu des difficultés pour poster une réponse!
Voici l'algo utilisé par l'ASM:
function Pos(Const Substr: AnsiString; Const S: AnsiString; var Depuis: Integer; jusqua: Integer = 0): Integer; var CTdeS,CTdeSub,PdeSub,PdeS : integer; //Compteur de la longueur de test de S begin //----------------------contrôles------------------------------- //test si Substr et S et Depuis sont valides Result:=0; if (SubStr = '') or (S = '') or (Depuis < 1) then exit; //vérification de jusqua afin de ne pas déborder la longueur de S if (jusqua <= 0) or (jusqua > Length(S)) then jusqua:=Length(S); //calcul de la longueur à tester et du début du test jusqua:=Succ(jusqua-Length(SubStr)); //der position de test CTdeS:=Succ(jusqua-Depuis); //si la zone de test est nul SubStr est trop long if CTdeS < 1 then exit; //--------------------------------------------------------------- //Depuis = Début du test dans S et CTdeS = compteur du Nb de Position Repeat if SubStr[1]=S[Depuis] then begin CTdeSub:=Pred(length(SubStr)); PdeSub:=2; //met en place suivant les CT de SubPtr PdeS:=Succ(Depuis);
while CTdeSub > 0 do begin if SubStr[PdeSub] = S[PdeS] then begin //position suivante et décrémente le compteur inc(PdeSub); inc(PdeS); dec(CTdeSub); end else CtdeSub:=-1; //pas trouvé d'égalité de char end;
if CtdeSub = 0 then begin //on à trouvé la correspondance à la Position Depuis Result:=Depuis; inc(Depuis,length(SubStr)); exit; //---------> sortie de la function avec TROUVE end; //autrement on continue à explorer le char suivant de S end; inc(Depuis); dec(CTdeS); Until CTdeS = 0; //pas sortie de la boucle donc pas trouvé Depuis:=1; Result:=0; end;
Il est évident que votre proposition sera plus rapide à l'exécution.
Je révise mon tuto et vais reprendre le code. Je trouve qu'il est plus facile en ASM
de tout reconstruire plutôt que de modifier.
Dès que ce sera au point je reviens vers vous.
Merci pour votre algo que je ne connaissais pas.
Piette
Tu dis "C'est pas certain; car cette façon de traiter est proche du raisonnement de l'ASM" : le problème c'est que tant qu'on n'a pas essayé on reste dans l'incertitude.
Par contre, si le code de Piette est une traduction ASM de l'algo basique, il est certain qu'une traduction ASM de l'algo Boyer-Morre sera plus rapide que la version ASM de l'algo basique, je pense qu'on est d'accord sur ce point, car il avance à grands pas dans les textes où la SubString est absente.
J'ai testé ton code qui marche à merveille.
Mais comme je suis nul en ASM je me permets de poser une question à propos de sa vitesse d'exécution :
Quel est le type d'algo à la base du code ? Car dans le cas où il s'agirait d'un algo basique qui compare TOUS les caractères de la SubString à ceux du texte-cible dans TOUTES les positions successives de la SubString il serait possible d'augmenter notablement la vitesse d'exécution en utilisant un algo à la façon Boyer-Moore qui se contente de ne comparer que le Dernier de la SubString à celui du texte-cible et qui avance d'un pas égal à la longueur de la SubString en cas de différence et qui ne compare les autres caractères de la SubString qu'en cas d'égalité avec le dernier caractère de la SubString. En bref, la vitesse d'exécution d'un algo Boyer-Moore augmente en fonction de la longueur de la SubString et de la longueur des zones du texte où cette SubString est absente, tandis qu'un algo basique pédale dans la choucroute à effectuer un nombre considérable de comparaisons inutiles.
A toutes fins utiles, voici une version PChar de StrPos de l'algo Boyer-Moore :
function BMHStrPos(const pTex, pMot: PChar): PChar; // StrPos à la façon Boyer-Moore-Horspool var it, im: Integer; // Indexes sur Texte et Mot LC, LM: Integer; // Longueur de pTex iav: Integer; // Indexe d'avancement pit, pim: PAnsiChar; // Indexes PChar ok: boolean; begin Result := nil; LC := Length(pTex); LM := Length(pMot); iav := LM; while iav <= LC do begin it := iav; im := LM; ok := true; while ok do begin pit := pTex + it - 1; pim := pMot + im - 1; if pit^ = pim^ then begin dec(im); dec(it); end else ok := false; if im = 0 then begin RESULT := pit; EXIT; end; end; // while ok ... inc(iav, LM - im + 1); end; // while iav <= LC end;
Je pense qu'en ASM cela devrait donc être plus rapide qu'en PChar.
Cordialement, et A+.
piette
Messages postés68Date d'inscriptionjeudi 11 décembre 2008StatutMembreDernière intervention16 juin 2019 31 mai 2015 à 20:10
Je tiens a te remercier pour ce tuto bien plus 'performant' que mon code.
Salutations
Rekin85
Messages postés25Date d'inscriptiondimanche 11 décembre 2011StatutMembreDernière intervention17 octobre 2015 31 mai 2015 à 18:06
Content que mon petit tuto sur l'Asm avec Delphi t'ai incité à produire du code performant...
15 sept. 2015 à 20:04
pour l'unité voir :
http://codes-sources.commentcamarche.net/source/view/101168/1380817
Salutations
5 sept. 2015 à 15:02
Bonjour,
je vais essayer, il n'est jamais facile de rassembler ces idées de façon simple.
Salutations
1 sept. 2015 à 22:46
Les baignades sont terminées, hélas.
Salutations.
24 juil. 2015 à 09:13
La function Fab_sauts() contient manifestement un concept novateur pour le Boyer-Moore. Serait-il possible d'avoir une explication simple de la chose ?
Merci beaucoup
17 juil. 2015 à 09:42
>> "J'ai regardé, c'est une autre façon de 'voir les choses'. Une autre approche.Mais plus rapide sans aucun doute, bravo."
A noter en plus que cette autre approche rend l'algo "tolérant certaines fautes de frappe" susceptibles de polluer les Textes dans lesquels on fait une recherche comme par exemple : je cherche "Yellow submarine" et l'un des textes contient "Yallow submarine" et l'autre "Yellow submarime"
Dans un tel cas l'algo trouve l'occurrence alors qu'un algo "strict" tel que PosEx ne la trouve pas.
>> "Je vais rester sur une approche binaire, ce sera intéressant de voir de combien la différence entre ces 2 approches se réduit en ms avec l'ASM?" :
Ce serait effectivement intéressant.
>> "Il est aussi possible de 'fouiller' avec votre méthode et ensuite de confirmer octets après octets la validité absolue de la 'trouvaille', ce qui marierai les 2 approches! " :
Bin comme ma méthode est tolérante à un certain nombre de fautes de frappe cela supposerait qu'il soit possible de confirmer par une logique :
- soit que les occurrences trouvées contiennent de simples fautes de frappe,
- soit qu'il s'agit d'occurrences parasites.
>> "je retourne sur la plage." :
Bonne baignade...
Cordialement, et à +.
16 juil. 2015 à 19:56
J'ai regardé, c'est une autre façon de 'voir les choses'.
Une autre approche.
Mais plus rapide sans aucun doute, bravo.
Je vais rester sur une approche binaire, ce sera intéressant de voir de combien la différence entre ces 2 approches se réduit en ms avec l'ASM?
Il est aussi possible de 'fouiller' avec votre méthode et ensuite de confirmer octets après octets la validité absolue de la 'trouvaille', ce qui marierai les 2 approches!
je retourne sur la plage.
Modifié par cs_pseudo3 le 13/07/2015 à 12:05
Pour en savoir plus sur l'astuce à la base de la vitesse d'exécution de BMHPascalC5T voir ici
http://www.developpez.net/forums/d1530223-2/environnements-developpement/delphi/algorithme-boyer-moore/
Voir le message d'Aujourd'hui 13/07/2015 à 11h09 (message n°#35) qui commence par "Le projet de Brute force de Rekin85 m'a donné une idée d'un Boyer-Moore "brutal" qui utilise un coulisseau à 5 Trous"
Je pense que l'amélioration est susceptible de vous intéresser.
Cordialement, et à +.
13 juil. 2015 à 11:47
Réponse au message de Piette du 12 juil. 2015 à 23:16
>> "voici une modif pour palier au problème d'initialisation du record: ":
OK, merci beaucoup.
Et voici les résultats de mes tests comparatifs de vitesse qui incluent une nouvelle routine de mon cru (BMHPascalC5T) basée sur une astuce qui augmente la vitesse d'exécution :
A) Pour 100 000 Recherches de Mot de 175 caractères aléatoires dans Texte de 97 345 caractères aléatoires et Mot présent 16 fois dans chaque texte
- Avec StrUtils.PosEx ASM version => Trouvé : 1 600 000 fois, Mis : 1 919 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 1 600 000 fois, Mis : 499 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 453 ms
- Avec BMHPascalNaifEx => Trouvé : 1 600 000 fois, Mis : 421 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 327 ms
- Avec ChercheDans => Trouvé : 1 600 000 fois, Mis : 2 465 ms
- Avec BMHPascalC5T => Trouvé : 1 600 000 fois, Mis : 297 ms
B) Pour 1 000 000 Recherches de Mot de 1 000 caractères aléatoires dans Texte de 20 200 caractères aléatoires et Mot présent 10 fois dans chaque texte
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 4 353 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 7 020 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 5 413 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 5 444 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 560 ms
- Avec ChercheDans => Trouvé : 10 000 000 fois, Mis : 7 878 ms
- Avec BMHPascalC5T => Trouvé : 10 000 000 fois, Mis : 140 ms
C) Pour 10 000 Recherches de Phrase de 554 caractères dans Texte de ZOLA de 1 048 838 caractères aléatoires et Phrase présente 1 fois en fin de texte
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 059 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 780 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 718 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 982 ms
- Avec ChercheDans => Trouvé : 10 000 fois, Mis : 3 448 ms
- Avec BMHPascalC5T => Trouvé : 10 000 fois, Mis : 764 ms
D) Pour 10 000 Recherches de Mot de 9 caractères 'Catherine' dans Texte de ZOLA de 1 048 838 caractères aléatoires et Mot présent ? fois dans chaque texte
- Avec StrUtils.PosEx ASM version => Trouvé : 2 390 000 fois, Mis : 12 137 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 2 390 000 fois, Mis : 6 583 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 2 390 000 fois, Mis : 5 881 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 2 390 000 fois, Mis : 12 137 ms
- Avec ChercheDans => Trouvé : 2 390 000 fois, Mis : 13 541 ms
- Avec BMHPascalC5T => Trouvé : 2 390 000 fois, Mis : 5 975 ms
E) Pour 10 000 Recherches de Mot de 12 caractères 'MOTFINALZOLA' dans Texte de ZOLA de 1 048 838 caractères aléatoires et Mot présent 1 fois en fin de texte
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 059 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 2 948 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 2 730 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 10 000 fois, Mis : 2 044 ms
- Avec ChercheDans => Trouvé : 10 000 fois, Mis : 3 089 ms
- Avec BMHPascalC5T => Trouvé : 10 000 fois, Mis : 2 948 ms
F) Pour 10 000 Recherches de Mot de 22 caractères 'Un débordement de sève' dans Texte de ZOLA de 1 048 838 caractères aléatoires et Mot présent ? fois dans chaque texte
- Avec StrUtils.PosEx ASM version => Trouvé : 20 000 fois, Mis : 12 496 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 20 000 fois, Mis : 3 479 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 20 000 fois, Mis : 3 198 ms
- Avec BMH_PosEX (Case Sensitive) => Trouvé : 20 000 fois, Mis : 12 527 ms
- Avec ChercheDans => Trouvé : 20 000 fois, Mis : 14 399 ms
- Avec BMHPascalC5T => Trouvé : 20 000 fois, Mis : 3 245 ms
Pour en savoir plus sur l'astuce à la base de la vitesse d'exécution de BMHPascalC5T j'en ai publié le principe et le code dans ce Forum (Oups j'ai oublié l'url) car ici les codes qu'on publie dans les commentaires disparaissent très vite.
Bon je récupère l'url de la discussion du Forum et je reviens.
Cordialement, et à +.
12 juil. 2015 à 23:16
Il semble que l'application console initialise var v2c : TreBMH2C; et pas l'application?
Je regarde :
le prog pour la possibilité de scruter des fichiers de 2^63-1 octets de long.
un prog pour définir la frontière entre BMH2C et force brut en fx des caractéristique du texte, ce qui revient à définir ctposDJ
ensuite je traduirai le tout en asm.
bon été
voici une modif pour palier au problème d'initialisation du record:
j'ai ajouté ceci:
procedure init_TreBMH2C(var BM : TreBMH2C);
12 juil. 2015 à 09:57
J'ai enfin trouvé la cause de la Violation d'accès : c'est l'instruction if BM.Par2chars <> nil then FreeMem(BM.Par2chars, BM.Volar2chars) qui la causait :
Résultats du test :
TEXTE : -Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!-Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!-Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!-Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!
len V2C.texte : 380
MOT : Bonjour de Bretagne ou il fait beau et reBonjour de Bretagne ou il fait beau, bonnes vacances!
2000000 trouvailles en ---------------78 ms
MOT : Bon
len V2C.texte : 380
4000000 trouvailles en ---------------125 ms
Cordialement, et à +.
10 juil. 2015 à 11:12
Réponse au message de Piette du 9 juil. 2015 à 22:20
Quand j'utilise votre code de test comme ci-dessous j'ai une Violation d'Accès qui se produit dans l'instruction située entre le ShowMessage('ici 1') et le ShowMessage('ici 2') :
Ce que je ne pige pas c'est pourquoi j'ai cette V.A ???
>> "il y a 2 voies suivant la longueur du mot : force brut Dword : Boyer Moore 2 caractères" :
Oui j'ai remarqué car si Length(Mot) < ctposDJ = 16 alors c'est la PosEX modifiée avec Depuis et Jusqua qui fait le boulot.
Cordialement, et à +.
9 juil. 2015 à 22:20
J'avais déjà livré _posDJ , mais pas facile a retrouver dans ces 102!
voici dessous :
ensuite mon testeur console :
il y a 2 voies suivant la longueur du mot
force brut Dword
Boyer Moore 2 caractères
avec votre pratique de l'aléatoire à zola vous pourrez affiner la constante :
ctposDJ = 16; //test posDJ si mot < ctposDJ
Pour passer d'un traitement à l'autre, le test joint montre une réduction très importante pour le traitement des mots courts de 939 ms (un type de traitement) à 179 ms (2 types de traitement) pour un mot de 3 chars
8 juil. 2015 à 11:47
Puis pour tester, ce serait sympa de donner un bout de code qui montre comment utiliser l'unit BMH2C.
Cordialement, et +.
Modifié par cs_pseudo3 le 8/07/2015 à 11:03
>> "j'ai un bout de prog pour tester." :
Voici un premier résultat du test : [Erreur fatale] BMH2C_Piette.pas(36): Fichier non trouvé : '_posDJ.dcu'
Il est où le code de _posDJ ???
>> "En faisant varier ctposDJ il est possible(?) de trouver la frontière entre les 2 types de traitements." :
C'est quoi ces 2 types de traitements ???
Cordialement, et à +.
7 juil. 2015 à 23:04
102!
j'ai un bout de prog pour tester.
En faisant varier ctposDJ il est possible(?) de trouver la frontière entre les 2 types de traitements.
3 juil. 2015 à 16:14
mais cette limite n'existe pas !!!
Et c'est pas parce que les fonctions demandes des strings en entrée qu'on ne peut pas rechercher du binaire avec !!!
pour vous un petit exemple avec une recherche d'image (de 144 507 Octets) dans un fichier binaire (exécutable)
@+ Cirec
1 juil. 2015 à 22:13
http://www.developpez.net/forums/d1530223/environnements-developpement/delphi/algorithme-boyer-moore/
1 juil. 2015 à 18:54
Mais avant d'en dévoiler le code, j'aurais besoin de savoir si elle tient le coup dans vos tests actuels et où elle se situe par rapport à vos performances. Malheureusement, il n'est pas possible d'adjoindre des fichiers aux topics d'ici... En plus ce lieu n'est pas propice, à mon avis aux échanges bien plus ouverts aux programmeurs.
Alors, si vous êtes d'accord, j'ai comme solution :
Soit d'ouvrir ici une nouvelle offre de code source
Soit de passer sur un autre site dédié à Delphi où le challenge proposé sera plus ouvert...
Qu'en dites-vous ?
Avec mes salutations.
1 juil. 2015 à 15:52
Le centième message
Depuis que DelphiFr est passé CS_CCM c'est la première fois qu'une discussion suscite autant de réponses ... Youpi pourvu que ça dure
il fallait bien marquer le coup !!!@+Cirec
30 juin 2015 à 18:13
cela viendra!
salutations
30 juin 2015 à 17:42
Résultats des tests avec utilisation de la nouvelle BIcompareSTR de Piette du 30 juin 2015 à 15:30
Pour le bon comptage des occurrences c'est OK.
Pour les tests de vitesse, les voici :
A) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 370 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 370 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 385 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 4 165 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 855 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 3 354 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 357 ms
- Avec V2C.chercheDans avec BIcompareSTR => Trouvé : 10 000 000 fois, Mis : 983 ms
B) Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de Zola de 1 048 842 caractères et Mot présent à la fin du texte
Compilé avec array[Byte] of Integer
:
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 028 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 752 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 112 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 127 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec V2C.chercheDans avec BIcompareSTR => Trouvé : 10 000 fois, Mis : 21 793 ms
Dommage que ce ne soit pas toujours la même routine à être la plus rapide.
Cordialement, et à +.
Modifié par piette le 30/06/2015 à 15:52
30 juin 2015 à 11:12
>> "J'ai regardé CompareSTR, il parait difficile de faire plus vite.
par contre la double table de saut est efficace à partir d'une vingtaine
d'octets"
Dommage qu'elle ne soit pas efficace dans tous les cas.
>> "Essayez cela: function BIcompareSTR(Const S1,S2: AnsiString; OffsetS2: integer): boolean; Register;":
Voici les résultats :
Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de ZOLA de 1 048 842 caractères et Mot présent 1 fois à la fin du Texte
Compilé avec array[Byte] of Integer :
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 2 200 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 767 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 112 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 144 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 996 ms
- Avec V2C.chercheDans et BIcompareSTR => Trouvé : 2 622 100 000 fois, Mis : 19 422 ms << ??? Bizarre
- Avec BMH_CompareSTR => Trouvé : 10 000 fois, Mis : 8 237 ms
Cordialement, et à +.
30 juin 2015 à 09:33
Essayez cela:
Salutations
Modifié par piette le 29/06/2015 à 23:42
J'étais tout à l'abri
sous ce toit de campagne
et regardais la pluie
tomber du ciel de Bretagne
De juillet à début Septembre.
J'ai regardé CompareSTR, il parait difficile de faire plus vite.
par contre la double table de saut est efficace à partir d'une vingtaine
d'octets
K:=K+FPar2chars^[FarNchar[ord(Texte[Pred(FLsubSTR)+K])]+
FarNchar[ord(Texte[FLsubSTR+K])]*FNlignes];
traduit en assembleur par D5
00408BDD movzx eax,[ebx+$0000010c]
00408BE4 dec eax
00408BE5 cdq
00408BE6 push edx
00408BE7 push eax
00408BE8 mov eax,esi
00408BEA xor edx,edx
00408BEC add eax,[esp]
00408BEF adc edx,[esp+$04]
00408BF3 add esp,$08
00408BF6 movzx eax,[edi+eax-$01]
00408BFB movzx eax,[ebx+eax+$04]
00408C00 movzx edx,[ebx+$0000010c]
00408C07 add edx,esi
00408C09 movzx edx,[edi+edx-$01]
00408C13 movzx ecx,[ebx+$0000010e]
00408C1A imul edx,ecx
00408C1D add eax,edx
00408C1F mov edx,[ebx+$00000104]
00408C25 movzx eax,[edx+eax*2]
00408C29 add esi,eax
Un vrai poème!
Je regarderai cela + tard.
j'ai ajouté a T2chars l'option MAJ/min
avec un mot de 380 chars 820 ms MAJ/min comparé à 734 ms en binaire.
Bonnes vacances à vous
29 juin 2015 à 11:31
Je pense avoir localisé une autre partie du code qui cause la lenteur des appels à ChercheDans après avoir créé la routine BMH_CompareSTR basée sur le même modèle que BMH_PosEXD mais qui utilise directement CompareSTR mais avec une SkipTable beaucoup plus simple à utiliser :
Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de ZOLA de 1 048 842 caractères et Mot présent 1 fois à la fin du Texte
Compilé avec array[Byte] of Integer :
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 751 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 128 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 128 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec V2C.chercheDans => Trouvé : 10 000 fois, Mis : 26 894 ms
- Avec BMH_CompareSTR => Trouvé : 10 000 fois, Mis : 8 237 ms
D'où un facteur de gain de vitesse de 26 894 / 8 237 = 3,26 grâce au changement de la SkipTable.
Mais bon les 8 237 ms de BMH_CompareSTR restent importants comparativement aux routines qui mettent 1 981 ms ou 1 997 ms et qui n'utilisent pas CompareSTR.
Vous remarquerez ci-dessus que Inc(ik, skip22[Texte[ik]]); est beaucoup plus simple que l'instruction ci-après qui figure dans T2chars.chercheDans : K := K + Par2chars^[arNchar[ord(Texte[Pred(LsubSTR) + K])] + arNchar[ord(Texte[LsubSTR + K])] * Nlignes];
Donc, pour bénéficier du facteur de gain de vitesse de 3,26 la modification est simple à faire, il ne resterait plus qu'à trouver une astuce qui améliorerait la vitesse de CompareSTR.
Cordialement, et à +.
29 juin 2015 à 10:35
Réponse au message de Piette du 28 juin 2015 à 17:45
>> "Oui bien vu j'ai laissé un grain de riz dans mon sel, trop pressé entre valises et clavier." :
A) Test de bon fonctionnement :
Suite à [Erreur] _T2charsPiette.pas(59): Erreur de syntaxe de l'assembleur en ligne j'ai remplacé le Ya? par Yab
Ensuite les tests fonctionnent très bien avec des Mots à nombre de caractères multiples de 4 mais il y a une surprise avec les tests de vitesse :
B) Résultats des tests comparatifs de vitesses :
B1) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 416 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 386 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 400 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 5 616 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 855 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 3 417 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 341 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 1 046 ms
B2) Pour 10 000 - Recherches de Mot de 4 caractères (MOTF) dans Texte de ZOLA de 1 048 842 caractères et Mot présent 1 fois à la fin du Texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 fois, Mis : 1 997 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 fois, Mis : 1 996 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 fois, Mis : 1 982 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 fois, Mis : 8 767 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 fois, Mis : 8 112 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 fois, Mis : 8 127 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 fois, Mis : 1 981 ms
- Avec V2C.chercheDans => Trouvé : 10 000 fois, Mis : 26 895 ms
Bizarre cette subite lenteur : ???
>> A propos de "trop pressé entre valises et clavier".
Au fait, c'est indiscret de vous demander de quand à quand vous partez avec vos valises ??? Car je pense qu'on n'en pas fini à améliorer les codes.
Cordialement, et à +.
Modifié par piette le 28/06/2015 à 17:59
Oui bien vu j'ai laissé un grain de riz dans mon sel, trop pressé entre valises et clavier.
Je remets à jour _T2charsCL
le problème c'est l'absence de : JZ @Ya? dans function compareSTR.
une boucle cherche par 4 chars en même temps et une autre cherche
la fin entre 1 et 3 char par char, encore faut-il tester que la fin n'est pas 0 ? ce que je n'ai pas fait, KR85 dit il faut tester toujours, et toujours c'est sans fin!
Vous pouvez récupérer cette fonction pour la greffer dans les autres routines cela fonctionne ou doit fonctionner....j'espère.
voir la mise à jour ci dessus.
Salutations
Je change d'avis car je ne retrouve pas _T2charsCL
voici donc ci dessous la version corrigée:
28 juin 2015 à 17:23
En continuant les tests avec divers bouts de Phrase j'ai mis le doigt sur une bizarrerie obtenue avec V2C.chercheDans :
Pour 10 000 - Recherches de Bout de phrase de 32 caractères dans Texte de ZOLA de 1 048 842 caractères Bout de phrase présent 2 fois dans le texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 20 000 fois, Mis : 7 270 ms
- Avec posEXD ASM de Piette => Trouvé : 20 000 fois, Mis : 7 300 ms
- Avec PosDJ ASM de Piette => Trouvé : 20 000 fois, Mis : 7 286 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 20 000 fois, Mis : 3 260 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 20 000 fois, Mis : 2 824 ms
- Avec BMHPascalNaifEx => Trouvé : 20 000 fois, Mis : 2 870 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 20 000 fois, Mis : 7 317 ms
- Avec V2C.chercheDans => Trouvé : 0 fois, Mis : 3 010 ms
Et cette bizarrerie se manifeste également en recherchant un Mot de 12 caractères et idem avec un Mot de 4 caractères
On dirait que V2C.chercheDans a un problème avec les Mots à nombre de caractères multiple de 4.
Est-ce-que cette bizarrerie se produit aussi chez quelqu'un d'autre ???
Cordialement, et à +.
28 juin 2015 à 16:47
Réponse au message de Cirec du 28 juin 2015 à 15:13
>> "... mais ou sont les résultats de BMHPascalNaifEx ??" :
J'avais placé BMHPascalNaifEx entre crochets de commentaires vu qu'elle donne chez moi des résultats très voisins de BMHPascalNaif.":
Du coup je la fais participer de nouveau dans les tests suivants.
>> "...sinon j'avais oublié de précisé que les mots & les textes utilisés pour la recherche ne sont pas de type aléatoires mais de "vrais" textes:" :
Du coup j'ai fait un test avec la recherche d'une "vraie" Phrase dans un "vrai" texte de ZOLA d'environ 1 Mo
A) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 401 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 416 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 464 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 4 352 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 886 ms
- Avec BMHPascalNaifEx => Trouvé : 10 000 000 fois, Mis : 3 447 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 529 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 1 014 ms
B) Pour 100 000 - Recherches de Phrase de 821 caractères dans Texte de ZOLA de 1 048 842 caractères et Phrase présente en fin du texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 100 000 fois, Mis : 20 483 ms
- Avec posEXD ASM de Piette => Trouvé : 100 000 fois, Mis : 20 499 ms
- Avec PosDJ ASM de Piette => Trouvé : 100 000 fois, Mis : 20 498 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 100 000 fois, Mis : 6 974 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 100 000 fois, Mis : 6 427 ms
- Avec BMHPascalNaifEx => Trouvé : 100 000 fois, Mis : 6 411 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 100 000 fois, Mis : 6 490 ms
- Avec V2C.chercheDans => Trouvé : 100 000 fois, Mis : 4 789 ms
Cordialement, et à +.
28 juin 2015 à 15:13
j'ai vu que tu as reproduit la recherche de 175 caractères aléatoires dans Texte de 97 351 caractères
mais ou sont les résultats de BMHPascalNaifEx ??
sinon j'avais oublié de précisé que les mots & les textes utilisés pour la recherche ne sont pas de type aléatoires mais de "vrais" textes:
Mot est une ou plusieurs lignes de code
et Texte un Code Source ...
et ce type de recherche met à mal les performances de BMH_PosEXD
surtout si Mot commence par un ou deux espaces et finit par un retour chariot (CRLF #13#10)
Et ces 3 caractères sont logiquement présents et dans tous les textes et en très grande quantité ... ce qui change tout aux résultats
Si je recherche Mot sans espaces et sans retour chariot :
BMH_PosEXD & BMHPascalNaifEx sont au coude à coude
Avec BMHPascalNaif => Trouvé : 16 fois, Mis : 312 ms dont 312 ms uniquement pour les appels à BMHPascalNaif
Avec BMHPascalNaifEx => Trouvé : 16 fois, Mis : 234 ms dont 234 ms uniquement pour les appels à BMHPascalNaifEx
Avec PosExD => Trouvé : 16 fois, Mis : 1 266 ms dont 1 266 ms uniquement pour les appels à PosExD
Avec BMH_PosEXD => Trouvé : 16 fois, Mis : 250 ms dont 250 ms uniquement pour les appels à BMH_PosEXD
mais si tu veux rechercher un plagiat tu auras forcément des retours chariots et peut être des espaces.
Donc pour faciliter le tout j'utilise le Presse-Papier ... on sélectionne un texte avec la souri ... Ctrl+C et je l'utilise directement pour la recherche ... ça permet de changer le contenu et la taille de Mot très facilement et de relancer le teste dans la foulée
@+Cirec
28 juin 2015 à 12:58
Cirec "ah oui ... j'ai également testé sur le i7 le "problème" du (My)GetTickCount et aucun soucis à déclarer !!!" :
Donc c'est mon Intel Core i7 - 2700 K à 3, 5 GHz qui a une faille !!!???
Cordialement, et à +.
28 juin 2015 à 12:52
Et voici les résultats des tests comparatifs de vitesses avec la version de code de V2C.chercheDans de Piette d'aujourd'hui le 28 juin 2015 à 11:27 avec "une pincée de sel ASM" supplémentaire et avec GetTickCount :
A) Pour 10 000 - Recherches de Mot de 175 caractères aléatoires dans Texte de 97 351 caractères alétoires et Mot présent 16 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 160 000 fois, Mis : 203 ms
- Avec posEXD ASM de Piette => Trouvé : 160 000 fois, Mis : 187 ms
- Avec PosDJ ASM de Piette => Trouvé : 160 000 fois, Mis : 187 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 160 000 fois, Mis : 62 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 160 000 fois, Mis : 32 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 160 000 fois, Mis : 31 ms
- Avec V2C.chercheDans => Trouvé : 160 000 fois, Mis : 47 ms
B) Pour 100 000 - Recherches de Mot de 175 caractères aléatoires dans Texte de 97 351 caractères alétoires et Mot présent 16 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 1 600 000 fois, Mis : 1 903 ms
- Avec posEXD ASM de Piette => Trouvé : 1 600 000 fois, Mis : 1 903 ms
- Avec PosDJ ASM de Piette => Trouvé : 1 600 000 fois, Mis : 1 888 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 1 600 000 fois, Mis : 530 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 452 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 1 600 000 fois, Mis : 328 ms
- Avec V2C.chercheDans => Trouvé : 1 600 000 fois, Mis : 515 ms
C) Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires et Mot présent 10 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 292 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 322 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 308 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 6 754 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 887 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 513 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 1 029 ms
D) Pour Recherches de Mot de 510 caractères aléatoires dans 1 000 000 Textes de 15 300 caractères alaétoires : Mot présent 10 fois uniquement dans le dernier texte
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 2 823 ms
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 2 793 ms
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 327 ms dont
Sauts bridés par array[char] of Byte
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 fois, Mis : 109 ms (grâce à table de sauts en LongWord)
- Avec V2C.chercheDans => Trouvé : 10 fois, Mis : 250 ms
Cordialement, et à +.
28 juin 2015 à 11:45
En attendant les tests de la nouvelle version de code de Piette postée aujourd'hui 28 juin 2015 à 11:27, voici déjà les résultats des tests comparatifs de vitesse obtenus chez moi avec sa version précédente avec GetTickCount .
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 301 caractères alétoires : (Mot présent 10 fois dans chaque texte)
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 000 000 fois, Mis : 3 167 ms
- Avec posEXD ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 167 ms
- Avec PosDJ ASM de Piette => Trouvé : 10 000 000 fois, Mis : 3 214 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 000 000 fois, Mis : 4 165 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 2 886 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 000 000 fois, Mis : 1 513 ms
- Avec V2C.chercheDans => Trouvé : 10 000 000 fois, Mis : 4 680 ms
Pour 10 000 - Recherches de Mot de 175 caractères aléatoires dans Texte de 97 351 caractères alétoires et Mot présent 16 fois dans chaque texte
Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 160 000 fois, Mis : 218 ms
- Avec posEXD ASM de Piette => Trouvé : 160 000 fois, Mis : 188 ms
- Avec PosDJ ASM de Piette => Trouvé : 160 000 fois, Mis : 187 ms
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 160 000 fois, Mis : 62 ms
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 160 000 fois, Mis : 47 ms
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 160 000 fois, Mis : 31 ms
- Avec V2C.chercheDans => Trouvé : 160 000 fois, Mis : 78 ms
Cordialement, et à +.
Modifié par piette le 28/06/2015 à 11:29
Une pincée de sel ASM dans la soupe Delphi améliore la vitesse de cuisson!
Salutations
27 juin 2015 à 16:59
Merci pour les compliments,
c'est un plaisir partagé d'avoir confronté nos programmes.
Bonnes vacances.
Modifié par piette le 27/06/2015 à 16:53
Les vacances approchent finissons-en (avec le boulot).
Je vous livre une version à 2 chars qui fonctionne bien (à tester plus profondément).
Il y avait une difficulté avec le masque à deux chars en particulier le second char,
j'ai résolu ceci sans test en modifiant la table (que l'on peut voir).
Je fais ceci avec D5 (qui ne veut plus dépasser XP).
j'utilise W8+OracleVirtualBox+XP
voila: l'unité puis le testeur
Puis le testeur avec explication du dernier char du maque:
Bonnes vacances.
Modifié par Cirec le 27/06/2015 à 16:29
en premier je veux féliciter Piette pour son excellent travail et en particulier sur la partie ASM ...
chapeau bas Monsieur et Merci pour le partage ;)
et si j'ai bien compris ... passe de bonnes vacances !!!
Sinon pour les testes .. vu qu'on utilise tous un compilateur différent (Piette en D5 je crois, Pseudo3 en D6, et moi en D7 ou D2009) et que ce détail a toute son importance puisque chez moi, après de nouveaux testes, BMHPascalNaifEx reste très régulièrement en tête et parfois même de manière écrasante: et que depuis D2009 Delphi est en Unicode du coup les versions ASM & PByte ne fonctionnent pas (en l'état) mais c'est la version PChar qui tient le haut du pavé.
on a donc sous D7
BMHPascalNaifEx à + 80% en tête
le reste du temps est partagé entre L'ASM et BMH_PosEXD
et sous D2009
PosBM_Mickey974ModifExPChar qui reste invariablement en tête.
tout ça pour dire qu'on ne se bat pas à armes égales et qu'il est difficile de comparer notre travail. Alors que le code source est identique pour tous le code machine (compilé) produit, lui est différent en fonction du compilateur utilisé. Il n'y a donc pas de comparaison possible ... sauf peut être pour les versions ASM
ah oui ... j'ai également testé sur le i7 le "problème" du (My)GetTickCount et aucun soucis à déclarer !!!
Sur ce ... bonne journée et
@+ Cirec
27 juin 2015 à 12:09
Réponse au message de Piette du 26 juin 2015 à 23:46
>> "Je vous propose un 1° jet de BMH avec 2 caractères . Ceci devrait être plus rapide?" :
Si on appelle la function T2chars.chercheDans(const Texte: string): integer dans une boucle elle revoie systématiquement la position de la première occurrence donc ça fausse la compétition.
Il faudrait la modifier comme suit function T2chars.chercheDans(const Texte: string; var PositionDepuisSuivante : integer): integer; pour pouvoir l'obliger à chercher les occurrences suivantes.
Cordialement, bonnes vacances, et à +.
Modifié par piette le 27/06/2015 à 00:05
En Effet.
J'ai lâché l'ASM pour regarder de plus près BMH que vous m'avez fait découvrir.
Je vous propose un 1° jet de BMH avec 2 caractères . Ceci devrait être plus rapide?
Voici pour voir:
Puis le testeur:
Je prends le large dans quelques jours sans clavier
Bonne vacances
26 juin 2015 à 15:51
Voici un test comparatif de vitesses qui illustre l'avantage du Boyer-Moore : lorsqu'on recherche un Mot ou une phrase longs dans beaucoup de textes dans lequel il est absent sauf une poignée d'entre-eux il traverse les premiers à grands sauts égaux à LenSub tandis que les autres codes rament dans la choucroute :
Résultats pour Recherches d'un Mot de 510 caractères aléatoires dans 1 000 000 Textes de 15 300 caractères alétoires : Mot présent 10 fois uniquement dans le dernier texte :
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 2 839 ms dont 2 761 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 2 824 ms dont 46 ms uniquement pour les appels à posEXD
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 fois, Mis : 109 ms dont 94 ms uniquement pour les appels à BMH_PosEXD
Soit une vitesse multipliée par 26 dans le cas d'un Mot ou d'une phrase de 510 caractères.
Cordialement, et à +.
26 juin 2015 à 14:58
Oups, il manque un bout de code pour pouvoir utiliser le code de BMH_PosEXD : j'ai oublié celui de InitSkip22
Cordialement, et à +.
26 juin 2015 à 14:26
Réponse aux messages de Piette du 25 juin 2015 à 19:06 et de Cirec du 26 juin 2015 à 12:28
>> Concernant MyGetTickCount :
Je viens aussi de comparer la version de MyGetTickCount de Cirec à GetTickCount et ça me donne aussi des durées environ 3 fois supérieures à celles de GetTickCount (Intel Core i7 - 2700 K à 3,5 GHz, sous Windows 7 premium)
Mais bon on peut se contenter de GetTickCount dès lors que les tests comparatifs de vitesse sont tels que toutes les durées sont suffisamment grandes (il suffit d'augmenter le nombre de boucles d'appels de sorte que chaque durée est supérieure à une seconde)
De toutes façons avec ou sans GetTickCount, avec ou sans MyGetTickCount, il paraît que Windows prend la main quand ça lui chante pour la rendre quand ça lui chante.
>> Concernant BMHPascalNaifEx
Si "tout est ok" chez Cirec alors tant mieux
Il y a effectivement des erreurs et des différences de comportement que je suis le seul à avoir, mais comme l'erreur ne se produit qu'avec des Mots d'un seul caractère et que je ne recherche jamais de tels mots on peut laisser tomber vu que ça règle le problème.
>> Concernant les points forts et faibles de BMHPascalNaif et de posEXD :
Comme posEXD qui n'est pas du type Boyer-Moore est plus lente que BMHPascalNaif lorsque la longueur de la SubString est supérieure ou égale à 18 et plus rapide dans les autres cas j'ai créé la fonction BMH_PosEXD qui marie les deux pour bénéficier des points forts des deux :
Voici les résultats de tests comparatifs de vitesse (avec GetTickCount) :
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 300 caractères alétoires : Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 651 ms dont 3 478 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 3 650 ms dont 3 540 ms uniquement pour les appels à posEXD
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 4 774 ms dont 4 697 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 6 708 ms dont 6 536 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 3 588 ms dont 3 509 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 5 507 ms dont 5 383 ms uniquement pour les appels à Pos_BMH
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 fois, Mis : 2 933 ms dont 2 840 ms uniquement pour les appels à BMHPascalNaif
- Avec BMH_PosEXD (Case Sensitive) => Trouvé : 10 fois, Mis : 1 591 ms dont 1 467 ms uniquement pour les appels à BMH_PosEXD
On constate qu'en mariant posEXD à BMHPascalNaif dans BMH_PosEXD la vitesse d'exécution de BMH_PosEXD est multiplée par :
- 1,84 si comparée à BMHPascalNaif
- 2,29 si comparée à posEXD ou à posEX
Et voici le code de BMH_PosEXD :
>> Concernant la nouvelle posDJ(m,T,Depuis,jusqua) de Piette:
On peut aussi créer une BMH_PosEXDJ() avec la posDJ() en modifiant légèrement le code ci-dessus pour bénéficier d'un gain de vitesse similaire..
Cordialement, et à +.
Modifié par Cirec le 26/06/2015 à 12:36
j'avais bien compris et j'avais testé la bonne fonction BMHPascalNaifEx et tout est ok chez moi
quelque chose n'est pas très claire dans tout cela !!
il y a des erreurs et des différences de comportement que tu sembles être le seul à avoir
Idem pour MyGetTickCount qui est connue depuis longtemps et qui fonctionne parfaitement ... je viens de refaire un petit teste entre GetTickCount et MyGetTickCount
Les résultats sont identiques la majorité du temps, pour le reste MyGetTickCount annonce une milliseconde de moins sur un intervalle d'une seconde ... ce qui normal vu sa précision. Mais en aucun cas 3 fois plus de temps !!
On utilise généralement MyGetTickCount pour avoir une plus grande précision ... quand GetTickCount retourne 0 ms MyGetTickCount peut retourner une valeur > 0
j'ai testé sous XP et Seven il me manque qu'un teste sur le i7
sinon la MSDN dit : qu'à partir de XP l'appel à la fonction QueryPerformanceCounter réussit toujours et que la valeur de retour de QueryPerformanceFrequency est défini au Boot et reste la même pour tous les process.
On peut donc écrire MyGetTickCount comme ceci et économiser quelques cycles à chaque appel:
@+ Cirec
25 juin 2015 à 19:06
étonnant ce chrono il fonctionne trés bien avec ma version XP?
j'ai repris posEX pour le modifier complètement comme mon 1° prog
pos(m,T,Depuis,jusqua) c'est
posDJ(m,T,Depuis,jusqua)
il est plus lent d'une nanoseconde que posEXD
mes tests et mon chrono
posEXD = 382 ms
posDJ = 423 ms
Pos = 473 ms
25 juin 2015 à 18:12
>> "Essayez ce chrono, il est plus précis : "
Sauf qu'il donne des résultats 3 fois supérieurs à GetTickCount, ce n'est probablement pas des millisecondes :
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 303 caractères alétoires : Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 10 662 ms dont 6 995 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 10 580 ms dont 6 839 ms uniquement pour les appels à posEXD
Cordialement, et à +.
25 juin 2015 à 17:28
Essayez ce chrono, il est plus pécis:
Modifié par Cirec le 25/06/2015 à 12:36
Réponse au message de Piette du 24 juin 2015 à 22:19
>> "L'astuce c'est la chance!
J'ai modifié PosEX en PosEXD avec la variable Depuis intégrée,
mais pas la constante jusqua afin de délimiter un champs, cela doit être plus
rapide que mon premier prog asm force brute, je vous le joins pour la compétition " :
Ok, si l'astuce est la chance y a rien à y piger, d'ailleurs à force de faire des tests de vitesse on découvre souvent des comportements surprenants des codes.
PosEXD est effectivement plus rapide que votre Pos_BMH du 20 juin et même un chouillia plus rapide que PosEx.
Voici les résultats de la compétition :
Pour 1 000 000 - Recherches de Mot de 510 caractères aléatoires dans Texte de 15 303 caractères alétoires : Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 604 ms dont 3 402 ms uniquement pour les appels à StrUtils.PosEx
- Avec posEXD ASM de Piette => Trouvé : 10 fois, Mis : 3 541 ms dont 3 228 ms uniquement pour les appels à posEXD
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 4 914 ms dont 4 695 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 4 540 ms dont 4 322 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 3 728 ms dont 3 382 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 5 335 ms dont 5 208 ms uniquement pour les appels à Pos_BMH
- Avec BMHPascalNaif (Case Sensitive) => Trouvé : 10 fois, Mis : 2 917 ms dont 2 711 ms uniquement pour les appels à BMHPascalNaif
Et voici un extrait du début du code de tests :
Coridalement, et à +.
Modifié par Cirec le 25/06/2015 à 12:35
L'astuce c'est la chance!
J'ai modifié PosEX en PosEXD avec la variable Depuis intégrée,
mais pasla constante jusqua afin de délimiter un champs, cela doit être plus
rapide que mon premier prog asm force brute, je vous le joins pour la compétition
Pour répondre plus sérieusement à votre question, je ne sais pas, il faut décortiquer les autres progs.
Une technique répandue des processeurs est appelée exécution spéculative. Cette technique utilise les possibilités de traitement en parallèle du processeur pour exécuter plusieurs instructions à la fois dont spéculer sur les branchements et il est très difficile pour un amateur
comme moi de savoir quelle instruction serait la plus rapide, c'est pour cela que je parlai de chance.
J'ai testé pos(1° version) et posEXD
pour 10000000 de 6 tests
posEXD = 691 ms (pas de gestion de jusqua)
POS = 872 ms (dont une gestion de jusqua)
soit posEXD est 3 nanosecondes plus rapide que POS pour une recherche.
Bonne suite
Bon tests.
24 juin 2015 à 16:08
Réponse au message de Piette du 24 juin 2015 à 14:28
>> "Poséx utilise la force brute / 4.Donc c'est plus rapide pour substr/4 " :
Oui, j'ai remarqué.
Tenez si ça vous intéresse : Comparatif des durées d'exécution des diverses SkipTables :
Pour 10 000 000 Initialisations de chaque SkipTable :
- Avec InitSkip(Mot) de KR85 : Mis : 421 ms
- Avec InitFastSkip(Mot, TRUE) de Cirec : Mis : 624 ms
- Avec InitFastSkip(Mot, FALSE) de Cirec : Mis : 640 ms
- Avec initBMH_sauts(Mot) de Piette : Mis : 250 ms : Chapeau !!!
- Avec InitSkip22(Mot, FALSE) de GG: Mis : 826 ms
- Avec InitSkip22(Mot, TRUE) de GG: Mis : 827 ms
Mais comme on fait appel à elles qu'une seule et unique fois avant les appels répétitifs au routines de recherche ces différences ne sont pas trop handicapantes.
C'est quoi l'astuce qui fait la vélocité de votre initBMH_sauts ?
Cordialement, et à +.
24 juin 2015 à 14:28
Poséx utilise la force brute / 4.
Donc c'est plus rapide pour substr/4
Un peu moins pour substr/2
Et moins pour substr impair
Et moins pour les mots longs.
Bons tests
24 juin 2015 à 11:45
A) Mon message du 21 juin 2015 à 11:13 concernait les résultats obtenus en corrigeant le code d'utilisation de BMHPascalNaifEx exactement suivant tes instructions et ça a bien corrigé le nombre d'occurrences trouvées avec elle, donc ce problème est réglé.
Par contre je viens de me rendre compte qu'il y a une erreur dans mon message du 21 juin 2015 à 11:13 où j'ai écrit :
"Si on cherche les occurrences de u présent 3 fois dans 0123une456789012345678une90123456une789012345678901234567890123456789123
Pour nb-Recherches = 1 :
- Avec BMHPascalNaif => Trouvé : 36 fois, Mis : 0 ms dont 0 ms uniquement pour les appels à BMHPascalNaif " :
J'y ai oublié le Ex et ça ne concerne donc que BMHPascalNaifEx et pas tes autres routines.
Par contre si on y cherche un ou une alors BMHPascalNaifEx trouve correctement les 3 occurrences présentes.
B) J'ai aussi remarqué autre chose en comparant PosEX à ma BMHPascalNaif en faisant varier la longueur du Mot de 10 à N pour déterminer la longueur minimale pour laquelle les deux se valent car le Boyer-Moore vu son principe est d'autant plus rapide que la longueur du Mot est grande et que le mot est absent dans les Textes dans lesquels on le cherche car c'est dans ce cas qu'il avance par sauts de longueur égale à celle du Mot.
Résultats :
Pour 1 000 000 de Recherches de Mot de LM caractères aléatoires présent 15 fois dans Texte de 15 300 caractères aléatoires :
GRNWPWMTKZ < LM = 10 dans LT = 15300
- Avec PosEx => Trouvé : 15 fois, Mis : 3 026 ms
- Avec BMHPascalNaif => Trouvé : 15 fois, Mis : 4 977 ms
.... Suite de la boucle
GDRNBZOQEMBSFCBGKR < = LM 18 dans LT = 15300
- Avec PosEx => Trouvé : 15 fois, Mis : 3 057 ms
- Avec BMHPascalNaif => Trouvé : 15 fois, Mis : 2 964 ms
... EXIT boucle lorsque LM = length(Mot) >= 18
Donc pour optimiser la vitesse on peut faire appel à PosEx si LM < 18 et à BMHPascalNaif si LM >= 18
(temps d'exécution et LM valables pour Intel Core i7 - 2700 K à 3, 5 GHz)
Cordialement, et à +.
23 juin 2015 à 18:00
j'ai refait tous les testes avec toutes les fonctions que j'ai et je n'ai aucuns des problèmes que tu décris !!!
pour SelStart je suis à Po -1 ce qui est tout à fait normal si l'on considère la description dans l'aide de Delphi:
soit tu as mal recopié mes codes (bug durant le copier coller) ou tu utilises tes propres modifications ou je ne sais quoi d'autre .... mais chez moi tout fonctionne comme il se doit !
regardes ton code, compares le au miens et si tu ne trouves pas de différences je te ferai une nouvelle copie pour tester ;)
@+ Cirec
21 juin 2015 à 11:13
Réponse aux messages de Cirec du 20 juin 2015 à 18:11 et du 20 juin 2015 à 19:23
>> "Teste déjà ça pour voir si ça corrige le problème : "
OK, merci ça corrige bien le problème du nombre d'occurrences trouvées, mais il reste un inconvénient mineur qui n'apparaît que lorsqu'on se sert de la position pour colorier les Mots trouvés dans un RichEdit : les positions sont décalées de 2 mais on peut s'en sortir avec un SelStart := Po - 2;
La correction réduit également le temps d'exécution puisque avant correction pour afficher 27 occurrences au lieu de 10 elle recherchait visiblement 3 fois 9 occurrences :
- Avec BMHPascalNaif => Trouvé : 10 fois, Mis : 2 964 ms dont 2 794 ms uniquement pour les appels à BMHPascalNaif
Avec BMHPascalNaifEx => Trouvé : 10 fois, Mis : 3 510 ms dont 3 199 ms uniquement pour les appels à BMHPascalNaifEx
En plus de ceci sans vouloir t'agacer j'ai encore trouvé une autre faille :
Si on cherche les occurrences de u présent 3 fois dans 0123une456789012345678une90123456une789012345678901234567890123456789123
Pour nb-Recherches = 1 :
- Avec BMHPascalNaif => Trouvé : 36 fois, Mis : 0 ms dont 0 ms uniquement pour les appels à BMHPascalNaif
J'avais le même problème lorsque j'ai corrigé ma version de BMHPascalNaif et je me suis dit que si quelqu'un cherchait le nombre de C, T, A ou G dans une séquence d'A.D.N ce serait impossible du coup j'ai remplacé le 2ième While par un Repeat.
Cordialement, et à +.
20 juin 2015 à 19:23
ce qui m'amène au problème suivant dans ton code :
pour passer à l'occurrence suivante il faut faire :
Depuis := Po + LM; Po = Position précédente LM = Longueur du Mot !
toi tu fais
Depuis := Po + LM + 1; erreur que j'ai véhiculé en recopiant sans regarder le code :(
soit ta fonction renvoie une mauvaise position ou ton Depuis est faussé
prenons l'hypothèse d'un Mot de 4 caractère dont la première occurrence se trouve au tout début du texte :
on a LM = 4
et Po = 1
la recherche suivante doit se faire à partir de la position 5 ... Donc de LM=4 + Po=1 = 5
avec ton code elle se fait à partir de 5 mais dans ce cas c'est la position de l'occurrence qui est fausse
on a LM=4 + Po=0 + 1 = 5
Pour corriger tout cela il te faut ajouter 1 à la valeur de sortie de la fonction (mais que pour ta fonction):
ça n'a aucune incidence sur le teste mais sur l'exactitude de la position renvoyée par la fonction
et retirer le + 1 au passage à l'occurrence suivante et ceci est valable pour toutes les fonctions testées
@+ Cirec
20 juin 2015 à 18:11
remplace déjà ton code de teste par celui-ci:
Teste déjà ça pour voir si ça corrige le problème
@+ Cirec
20 juin 2015 à 17:32
J'ai fait des tests comparatifs de vitesse avec votre Pos_BMH du 20 juin en ASM,
les résultats des tests figurent dans mon message du 20 juin 2015 à 15:46 intitulé "Réponse au message de Cirec - 20 juin 2015 à 12:54"
Cordialement, et à +.
20 juin 2015 à 15:46
Réponse au message de Cirec - 20 juin 2015 à 12:54
>> "j'ai retiré tout ce qui me semblait être inutile et redondant et le résultat s'en fait ressentir, surtout
sur des recherches de mots long, c'est la plus véloce ... jusqu'à 50% plus rapide que l'original !!" :
Je viens de tester BMHPascalNaifEx pour comparer aux autres mais j'ai des résultats bizarres :
Avec paramètres de recherche :
Résultats :
Pour 1 000 000 - Recherches de Mot de 510 caractères dans Texte de 15 300 caractères: Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 385 ms dont 3 184 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 7 051 ms dont 6 861 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 10 fois, Mis : 7 129 ms dont 6 927 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 4 821 ms dont 4 634 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 4 602 ms dont 4 340 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 10 fois, Mis : 5 928 ms dont 5 713 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec BMHPascalNaif => Trouvé : 10 fois, Mis : 2 980 ms dont 2 810 ms uniquement pour les appels à BMHPascalNaif
- Avec Pos_BMH du 20 juin de Piette => Trouvé : 10 fois, Mis : 5 132 ms dont 4 914 ms uniquement pour les appels à Pos_BMH
- Avec BMHPascalNaifEx => Trouvé : 27 fois, Mis : 9 968 ms dont 9 313 ms uniquement pour les appels à BMHPascalNaifEx
27 fois ça fait beaucoup trop!
Mais je l'ai peut-être mal utilisée donc voici le bout de code du test qui concerne BMHPascalNaifEx :
Cela fait un moment que cherche la cause de l'anomalie sans la trouver...
Par contre, au passage, on remarque parmi les résultats ceux de Pos_BMH en ASM de Piette avec ses 5 132 ms elle n'est pas plus rapide que PosEx.
Cordialement, et à +.
20 juin 2015 à 13:05
Réponse au message de Cirec - 20 juin 2015 à 12:32
>> "Bon c'est un peu le bordel ces messages qui s'intercalent entre les réponses !!" :
Oui, c'est agaçant, et en plus on ne voit plus les premiers messages de la discussion, et puis ce qui manque cruellement c'est qu'on n'est plus prévenu par mail de l'arrivée d'une nouvelle réponse ou question.
>> "voici la correction du code BMHPascalNaif qui fonctionne et trouve toutes les occurences " :
Oups je viens aussi de mon coté de la corriger comme suit :
et elle trouve aussi toutes les occurrences
>> "voilà tout est rentré dans l'ordre sauf pour la vitesse ... elle reste bonne dernière :"
Bizarre car chez moi elle arrive en tête avec les paramètres de recherche suivants :
Pour 1 000 000 - Recherches de Mot de 510 caractères dans Texte de 15 300 caractères: Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 10 fois, Mis : 3 525 ms dont 3 372 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 10 fois, Mis : 4 758 ms dont 4 571 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 10 fois, Mis : 7 426 ms dont 7 315 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 10 fois, Mis : 4 290 ms dont 4 010 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 10 fois, Mis : 4 602 ms dont 4 414 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 10 fois, Mis : 6 115 ms dont 5 831 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec BMHPascalNaif => Trouvé : 10 fois, Mis : 2 996 ms dont 2 728 ms uniquement pour les appels à BMHPascalNaif
Et voici le code de StrAleatoireMinus et Majus pour la création des paramètres de recherche aléatoires :
Bon, sur ce je vais tester le code de Piette.
Cordialement, et à +.
end;
20 juin 2015 à 12:54
j'ai retiré tout ce qui me semblait être inutile et redondant et le résultat s'en fait ressentir, surtout
sur des recherches de mots long, c'est la plus véloce ... jusqu'à 50% plus rapide que l'original !!
@+ Cirec
20 juin 2015 à 12:32
du coup je poste ma réponse à la suite ;)
voici la correction du code BMHPascalNaif qui fonctionne et trouve toutes les occurences ;)
il y avait 2 erreurs
- La correction dans le code ci-dessus
- Une erreur de ma part ... j'essayai de faire une comparaison avec une fonction case sensitive et une table de sauts non case sensitive !!!!
voilà tout est rentré dans l'ordre sauf pour la vitesse ... elle reste bonne dernière :(
@+ Cirec
20 juin 2015 à 09:48
Réponse au message de Cirec - 19 juin 2015 à 13:07
2eme point "... ça t'aurais permis de découvrir ou de constater des erreurs dans le code !!! ... ceci est aussi valable pour la dernière version BMHPascalNaif " :
OK, merci je vais rectifier le code.
4ème point " ...et tu as utilisé, pour tes testes, la version Byte "array[Byte] of Byte" alors que la version Integer "array[Byte] of Integer" est plus rapide "
:
En fait la version qui était utilisée par défaut était bien la version Integer "array[Byte] of Integer et l'erreur ne provenait que de l'affichage car je n'ai utilisé que ton *.pas en tant qu'unit supplémentaire utilisée à partir de la Form principale de mon application de tests (ça m'évite d'avoir à naviguer entre deux applications), et je n'avais pas désactivé la ligne qui contient la compilation conditionnelle. Mais ce problème d'affichage est maintenant réglé.
5ème point " ... sur le fond tu as raison mais sur la forme je ne suis pas d'accord d'une fonction de recherche j'attends quelle me permette de faire ma recherche ... case sensitive ou non, avec ou sans accents" :
Entièrement d'accord car les préférences personnelles ça se discute pas.
Pour ma part j'ai préféré simplifier car j'utilise la constante MNA essentiellement pour gommer les erreurs de frappe gommables vu que les erreurs d'accentuation sont très fréquentes et qu'on a l'habitude d'écrire des phrases en minuscules qui commencent généralement par une majuscule.
Et en plus ça réduit la quantité de tests à effectuer lors des recherches de gains de vitesse.
réponse à mon message suivant: "....chez moi que ce soit sur le vieux PC ou sur I7 la BMHPascalNaif reste bonne dernière !!!!!!" :
Bizarre, Je pense que ça vaudrait le coup de se mettre d'accord sur un ou deux protocoles de tests de vitesse simples, car c'est surprenant qu'elle soit la première chez moi et la dernière chez toi.
"... Mais le plus important c'est qu'elle n'est pas juste dans ses résultats !
alors que toutes les fonctions donnent un résultat de 100 occurrences trouvées sauf les non case sensitive qui elles en trouvent 104 ce qui est juste ;)
la BMHPascalNaif n'en trouve que 80 !!! " :
Ceci c'est bien plus fâcheux je vais chercher la cause de cette erreur et je reviens.
Cordialement, et à +.
Modifié par Cirec le 20/06/2015 à 11:48
Modifié par Cirec le 20/06/2015 à 11:48
Je livre ma modeste contribution dans cette course aux nanosecondes.
Ensuite je range mon tuto.
Ne rien lâcher dit Cirec,
Je fais relâche.
l'ASM c'est amusant et usant à la fois.
A Bientôt
le code de test
Modifié par Cirec le 19/06/2015 à 13:09
re
1er point je reviendrais dessus dans un autre message ;)
2eme point ça me revient maintenant pourquoi j'ai dit cela
ça t'aurais permis de découvrir ou de constater des erreurs dans le code !!!
en effet c'est grâce à l'utilisation de texte "normal" comme dans mon exemple que l'on s'en rend compte ;)
ceci est aussi valable pour la derniere version BMHPascalNaif
le 3ème point étant réglé on passe au suivant.
4ème point
Alors comment dire ...
- si je fourni un code complet avec *.pas + *. dfm + *.dpr
- si je mets des commentaires dans le code que j'ai doublé dans le message
- si vous n'en copiez qu'une partie pour vos essais
... je n'y peux rien ! t'as oublié de prendre la ligne qui contient la compilation conditionnelle ce qui a provoqué
la compilation du code avec array of Byte à la place de array of Integer
le 5ème point sur le fond tu as raison mais sur la forme je ne suis pas d'accord
d'une fonction de recherche j'attends quelle me permette de faire ma recherche
- en case sensitive,
- en non case sensitive,
- en tenant compte des accents,
- en ne tenant pas compte des accents
- en case sensitive, en tenant compte des accents,
- en case sensitive, en ne tenant pas compte des accents
- en non case sensitive, en tenant compte des accents,
- en non case sensitive, en ne tenant pas compte des accents
alors que dans ton cas il ne reste plus que:
- en case sensitive, en tenant compte des accents,
- en non case sensitive, en ne tenant pas compte des accents
réponse au message suivant:
chez moi que ce soit sur le vieux PC ou sur I7
la BMHPascalNaif reste bonne dernière !!!!!!
Mais le plus important c'est qu'elle n'est pas juste dans ses résultats !
alors que toutes les fonctions donnent un résultat de 100 occurrences trouvées sauf les non case sensitive qui elles en trouvent 104 ce qui est juste ;)
la BMHPascalNaif n'en trouve que 80 !!!
la première erreur est assez facile à mettre en évidence.
il suffit de rechercher un mot qui commence au tout début du texte:
ceci devrait faire l'affaire:
Texte := 'une chaine de texte .....pour une.....dans une etc. etc.';
Mot := 'une'
@+ Cirec
19 juin 2015 à 11:03
Comme les résultats de mes tests de vitesse d'hier m'ont un peu intrigué, en méditant sur ce sujet j'ai pris conscience qu'en faisant des recherches avec un mot du style StringOfChar('A', 510) j'avais placé malencontreusement les routines de Cirec en situation de ramer avec de nombreux sauts de 1 et quelques rares sauts de 510 vu la SkipTable que ça donne.
Donc voici les résultats plus réalistes avec un mot à rechercher de même longueur qu'hier mais formé par une chaîne aléatoire de Majuscules présent 6 fois dans un texte où il est séparé par des Minuscules aléatoires :
Pour 1 000 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: Compilé avec array[Byte] of Integer
Avec :
Mot := StrAleatoireMajus(510);
Separ := StrAleatoireMinus(1020);
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
Nouveaux résultats :
- Avec StrUtils.PosEx ASM version => Trouvé : 6 fois, Mis : 2 060 ms dont 1 936 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 2 776 ms dont 2 634 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 4 087 ms dont 3 947 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 2 574 ms dont 2 389 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 2 184 ms dont 2 091 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 3 526 ms dont 3 494 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec PosPietteASM => Trouvé : 6 fois, Mis : 10 343 ms dont 10 155 ms uniquement pour les appels à PosPietteASM
- Avec BMHPascalNaif => Trouvé : 6 fois, Mis : 1 794 ms dont 1 701 ms uniquement pour les appels à BMHPascalNaif
Les écarts de vitesse sont moins importants qu'hier mis à part pour ce qui concerne PosPietteASM ce qui est normal vu que ce n'est pas du Boyer-Morre
Par contre BMHPascalNaif reste pour l'instant la meilleure grâce au coulisseau à 2 trous qui vérifie s'il y a concordance simultanée sur la dernière lettre ET la première du mot cherché avant d'entamer la marche à reculons.
J'aime bien ce coulisseau à 2 trous car beaucoup de mots se terminent par la même lettre, ceux qui commencent avec la même et se terminent avec une même autre sont bien moins nombreux,
et ceux qui en plus ont la même longueur sont encore moins nombreux.
En plus si on tient compte du fait que beaucoup de mots se terminent par une séquence de caractères suffixes identiques comme par exemple :
- annuellement, cruellement, perétuellement, mensuellement, intellectuellement, spirituellement, graduellement, etc.
Dans ces cas les versions Boyer-Moore de Cirec, dès qu'il y a concordance sur le t terminal se précipitent à reculer jusqu'au u en perdant leur temps alors que la BMHPascalNaif gagne du temps s'il n'y a pas en même temps concordance sur la première lettre.
Et visiblement, ayant fait plusieurs tests similaires avec des mots et du texte aléatoires ceci se produit statistiquement fréquemment, donc si ça se produit même avec de l'aléatoire ça se produit forcément avec du langage courant.
Cordialement, et à +.
18 juin 2015 à 16:23
Voici d'abord les résultats de tests comparatifs de vitesse de codes dont un nouveau Boyer-Moore en Pascal qui décoiffe :
Avec les paramètres de recherche suivants :
Mot := StringOfChar('M', 510);
Separ := StrAleatoireMinus(1020); // Chaîne aléatoire de minuscules
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
nbTours := 10000;
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: Compilé avec array[Byte] of Integer
- Avec StrUtils.PosEx ASM version => Trouvé : 6 fois, Mis : 187 ms dont 171 ms uniquement pour les appels à StrUtils.PosEx
- Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 5 866 ms dont 5 866 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
- Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 7 800 ms dont 7 800 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
- Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 5 631 ms dont 5 631 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
- Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 4 010 ms dont 4 010 ms uniquement pour les appels à PosBM_Mickey974ModifString
- Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 5 818 ms dont 5 818 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
- Avec PosPascalNaif => Trouvé : 6 fois, Mis : 141 ms dont 141 ms uniquement pour les appels à PosPascalNaif
- Avec BMHPascalNaif => Trouvé : 6 fois, Mis : 15 ms dont 15 ms uniquement pour les appels à BMHPascalNaif
et même PosPascalNaif qui marche uniquement en avançant est plus rapide que la PosEx en ASM issu du challenge de Fastcode !!!
Et voici le code du Boyer-Moore en Pascal qui décoiffe :
Et voici le code de PosPascalNaif qui marche seulement en avançant :
Cordialement, et à +.
17 juin 2015 à 17:05
1) A propos de PosEX ASM : "La version ASM devient plus rapide de 1 à 8 caractères et à 9 caractères elle est identique à la version string
et à partir de 10 caractères recherchés c'est la version string qui prend la main." :
Chez moi c'est la PosEx que je viens de récupérer qui reste la plus rapide même avec les 510 caractères de tout à l'heure : Elle décoiffe carrément :
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: avec array[Byte] of Byte
Avec StrUtils.PosEx ASM version => Trouvé : 6 fois, Mis : 218 ms dont 203 ms uniquement pour les appels à StrUtils.PosEx
Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 5 351 ms dont 5 351 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 6 973 ms dont 6 973 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 4 883 ms dont 4 883 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 4 009 ms dont 4 009 ms uniquement pour les appels à PosBM_Mickey974ModifString
Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 5 897 ms dont 5 897 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
2) "quand je disais de varier les éléments de recherches c'est pas à ça que je pensais, il faudrait rester dans un cadre utile et naturel .... une recherche de 510 caractères identiques c'est pas une chose courante ;) ":
J'ai opté pour cette solution pour deux raisons :
- le Boyer-Moore avance à grands pas dans les zones où le Mot est absent d'où la recherche avec une chaîne longue,
- et lors d'une discussion avec Rekin85 (KR85) il a évoqué l'exemple d'une utilisation par un prof pour rechercher des plagiats par copier-coller de grande longueur.
3) " ... et le texte servant à la recherche ne contient que 2 caractères répétés" :
OK, pour la suite j'utiliserai du texte aléatoire.
4) " ... et tu as utilisé, pour tes testes, la varsion Byte "array[Byte] of Byte" alors que la version Integer "array[Byte] of Integer" est plus rapide ;)" :
Bin j'ai utilisé le code tel quel ne sachant pas ceci.
Je fais comment pour utiliser la version plus rapide et quel est l'intérêt de la version moins rapide ???
5) "... non c'est l'inverse "or $20" convertit les majuscules en minuscules tout en conservant les accents. c'est un choix délibéré de ma part, dans les recherches la case et les accents sont deux paramètres distincts" :
Ok, mais si on conserve les accents on risque d'avoir des résultats de recherche incomplets à cause de Textes pollués par des erreurs d'accentuation, alors qu'en convertissant en minuscules ou en majuscules non accentuées on gomme du même coup ces erreurs.
Cordialement, et à +.
17 juin 2015 à 14:40
Effectivement ... et ça m'a même permis de constater que la version ASM de PosEx ne figurait pas dans les sources de D7 !!!
Mais elle y est dans Delphi2009 avec une prise en charge de l'unicode.
Pas de panique vous pouvez télécharger le zip du fastcode challange sur le site (voir mon premier message)
ou sinon vous recopiez ce qui suit :
unit : PosExJOHUnit.pas
du coup les résultats changent radicalement ^^
La version ASM devient plus rapide de 1 à 8 caractères et à 9 caractères elle est identique à la version string
et à partir de 10 caractères recherchés c'est la version string qui prend la main.
quand je disais de varier les éléments de recherches c'est pas à ça que je pensais
il faudrait rester dans un cadre utile et naturel .... une recherche de 510 caractères identiques c'est pas une chose courante ;)
et le texte servant à la recherche ne contient que 2 caractères répétés
c'est pas très réaliste !
et tu as utilisé, pour tes testes, la varsion Byte "array[Byte] of Byte"
alors que la version Integer "array[Byte] of Integer" est plus rapide ;)
non c'est l'inverse "or $20" convertit les majuscules en minuscules tout en conservant les accents.
c'est un choix délibéré de ma part
dans les recherches la case et les accents sont deux paramètres distinct
@+ Cirec
17 juin 2015 à 12:41
Résultats des tests du code de Cirec:
A) Mis à part [Erreur] uCompareStrPos.pas(2088): Identificateur non déclaré : PosEx,
ce qui est normal car PosEx n'est apparu qu'après D6 que j'utilise le reste fonctionne correctement.
En plus si PosEx du Fastcode Challange reste la meilleurs pour une recherche de 1 à 3 caractères il resterait à savoir si elle resterait la meilleure pour la recherche de chaînes longues.
B) Vitesses avec :
Mot := StringOfChar('M', 510);
Separ := StringOfChar('o', 1020);
Texte := '';
for i := 1 to 6 do Texte := Texte + Separ + Mot;
Résultats avec Intel Core i7 - 2700 K à 3, 5 GHz :
Pour 10 000 - Recherches de Mot de 510 caractères dans Texte de 9 180 caractères: avec array[Byte] of Byte
Avec PosBM_Mickey974ModifExPByte => Trouvé : 6 fois, Mis : 5 366 ms dont 5 366 ms uniquement pour les appels à PosBM_Mickey974ModifExPByte
Avec PosBM_Mickey974ModifExPByteNonCaseSansitive => Trouvé : 6 fois, Mis : 6 989 ms dont 6 989 ms uniquement pour les appels à PosBM_Mickey974ModifExPByteNonCaseSansitive
Avec PosBM_Mickey974ModifExPChar => Trouvé : 6 fois, Mis : 4 883 ms dont 4 883 ms uniquement pour les appels à PosBM_Mickey974ModifExPChar
Avec PosBM_Mickey974ModifString => Trouvé : 6 fois, Mis : 4 009 ms dont 4 009 ms uniquement pour les appels à PosBM_Mickey974ModifString
Avec PosBM_Mickey974ModifNonCaseSansitive => Trouvé : 6 fois, Mis : 5 897 ms dont 5 897 ms uniquement pour les appels à PosBM_Mickey974ModifNonCaseSansitive
Donc chez moi aussi c'est la version string qui reste la plus rapide.
Par contre il reste un petit truc qui me chagrine dans InitFastSkip:
sauf erreur de ma part avec 'or $20' on ne convertit en Majuscules que les Minuscules non accentuées et le texte risque de comporter des alphabétiques accentués voire être pollué par des erreurs d'accents.
Pour ma part je préférerais utiliser pour cela une solution telle que l'utilisation de la constante MNA même si l'initialisation de la SkipTable est un chouilla plus lente, d'autant plus qu'on ne l'initialise qu'une seule fois en dehors des boucles d'appel et que ce n'est donc pas lors de cette initialisation qu'on cherche des gains de vitesse importants mais lors des boucles d'appel qui s'effectuent généralement avec la recherche du même Mot dans une série de N Textes différents.
Du coup je vais essayer de bidouiller InitFastSkip pour utiliser MNA.
Et comme le disait Cirec : "il ne reste plus qu'à tester une version ASM".
Cordialement, et à +.
17 juin 2015 à 10:39
Réponse au message de Cirec du 16 juin 2015 à 14:46
>> "j'ai fait de mon coté quelques testes dont je vous livre le code ... testez par vous même les résultats étant différents en fonction des compilateurs et des PC.
Je vous conseille de changer votre texte mais surtout le mot de recherche en faisant varier sa longueur de 1 à plus de 8 caractères" :
OK, merci pour cette contribution, je vais tester le code dès aujourd'hui puis en donner les résultats.
Cordialement, et à +.
17 juin 2015 à 10:38
Réponse aux messages de Piette du 16 juin 2015 à 23:27 et du 17 juin 2015 à 00:30
>> "Je n'arrive pas à lire votre table MNA ?
ici -> f"...+
la -> /00S<OE
puis -> µ¶·¸¹º»¼½¾¿"
C'est très simple la table MNA a été créée en y plaçant dans un premier temps tous les Chr(i) avec i de 0 à 255, et en y remplaçant dans un deuxième temps tous les caractères alphabétiques par leur Majuscule Non Accentuée.
Cela évite aux recherches d'être perturbées par des fautes d'orthographe fréquentes en particulier sur le choix des accents.
>> "La syntaxe est : const X : array[1..2] of char = ('A','B');" :
Bin non comme la table des caractères en contient 256 ce n'est pas array[1..2] of char mais array[Char] of Char
>> "Je pense qu'il serait moins fastidieux de placer votre table MNA dans un string?" :
Fastidieux pour quelle raison ? Je ne comprends pas d'autant plus qu'un string équivaut à une table indicée.
Par contre si ça devait améliorer la vitesse d'exécution je serais preneur.
Cordialement, et à +.
17 juin 2015 à 10:36
Réponse au message de Piette du 16 juin 2015 à 15:33
>> "Savez vous s'il existe l'équivalent de AnsiUppercase pour un char?":
Cet équivalent présenterait l'incovénient de remplacer un 'é ' par 'É' donc s'il y une erreur d'accent et que dans le texte on a un 'ê' à la place du 'é' on loupe la recherche.
Alors que l'utilisation de la constante MNA remplace TOUS les caractères alphabétiques par des Majuscules Non Accentués
>> "il me semblait recevoir ? des alertes lorsqu'il arrivait des messages, est-ce toujours le cas? (sauf pour moi)" :
Effectivement à une autre époque nous étions alertés par un mail chaque fois que quelqu'un ajoutait un commentaire ou une réponse. Et cette fonctionnalité manque cruellement.
Donc si quelqu'un pose une question sur un code qu'on a publié il y a quelques années la question risque de rester sans réponse jusqu'au jour où l'auteur du code passe par hasard par là et s'il répond à la question
plusiuers mois après c'est le questionneur qui ne saura pas qu'on lui a répondu.
Cordialement, et à +.
17 juin 2015 à 00:30
Je pense qu'il serait moins fastidieux de placer votre table MNA dans un string?
Salutations
Modifié par piette le 16/06/2015 à 23:41
J n'arrive pas à lire votre table MNA ?
ici -> f"...+
la -> /00S<OE
puis -> µ¶·¸¹º»¼½¾¿
La syntaxe est :
const X : array[1..2] of char = ('A','B');
Salutations
Modifié par piette le 16/06/2015 à 15:38
Savez vous s'il existe l'équivalent de AnsiUppercase pour un char?
String:=AnsiUpperCase(string);
Char:=Ansi??????????(char);
autre question basique:
il me semblait recevoir ? des alertes lorsqu'il arrivait des messages, est-ce toujours le cas? (sauf pour moi)
Salutations
Modifié par Cirec le 16/06/2015 à 15:09
j'ai fait de mon coté quelques testes dont je vous livre le code ... testez par vous même les résultats étant différents en fonction des compilateurs et des PC.
Je vous conseille de changer votre texte mais surtout le mot de recherche en faisant varier sa longueur de 1 à plus de 8 caractères
le code fourni prévoit tout ceci
il vous faut 1 TButton 1 TEdit 2 TMemo et "Facultatif" 1 TSpinEdit pour le nombre de répétitions
MainForm: unit4.pas
Voici le dfm : unit4.dfm
et le dpr : project5.dpr
J'ai également ajouté, par une compilation conditionnelle "{$DEFINE USE_INT}" au début de l'implémentation , la possibilité de tester la différence entre
array[Byte] of Integer;
et
array[Byte] of Byte;
ainsi qu'un teste avec la fonction PosEx du Fastcode Challange qui reste la meilleurs pour une recherche de 1 à 3 caractères ^^
chez moi la version string reste la plus rapide au delà de 4 caractères
il ne reste plus qu'à tester une version ASM ^^
voilà ... dites moi comment ça tourne chez vous
@+ Cirec
16 juin 2015 à 12:02
Je tiens à rectifier mon code Pascal d'hier à propos duquel je disais " : utile si on cherche des mots dans des textes où le mot peut être tantôt en majuscules tantôt en minuscules voire avec des caractères accentués ou des accents faux ou oubliés" car je viens de me rendre compte que la fonction UpCase ne passe en majuscules que les chr de chr(97) à chr(122) et pas les caractères accentués ni le "ç" avec la cédille donc voici le code corrigé :
Cordialement, et à +.
15 juin 2015 à 15:39
En fait l'utilisation de deux fonctions spécialisées dont l'une Ignore la casse et l'autre non ont quand même une petite différence de vitesse :
Pour Mot := '123456789' et Texte := 012345678901234567890123456789012345678901234567890123456789123
et nb-Recherches = 1000000 :
- Avec PosBM_Mickey_Ignore_Casse => Trouvé : 6 fois, Mis : 359 ms dont 154 ms uniquement pour les appels à PosBM_Mickey_Ignore_Casse
- Avec PosBM_Mickey974Modif_ => Trouvé : 6 fois, Mis : 187 ms dont 46 ms uniquement pour les appels PosBM_Mickey974Modif_
Cordialement, et à +.
15 juin 2015 à 15:03
Voici une modification du code Pascal pour Ignorer ou ne pas Ignorer les différences entre Majuscules et minuscules : utile si on cherche des mots dans des textes où le mot peut être tantôt en majuscules tantôt en minuscules voire avec des caractères accentués ou des accents faux ou oubliés.
Résultats de tests de vitesse :
Avec Mot := '123456789' et Texte := '012345678901234567890123456789012345678901234567890123456789123'
Pour nb-Recherches = 1000000 :
- Avec PosBM_Mickey_Casse => Trouvé : 6 fois, Mis : 328 ms dont 125 ms uniquement pour les appels à PosBM_Mickey_Casse (Sans ignorer la casse)
- Avec PosBM_Mickey_Casse => Trouvé : 6 fois, Mis : 468 ms dont 328 ms uniquement pour les appels à PosBM_Mickey_Casse (Avec Ignorer la casse)
- Avec PosBM_Mickey974Modif_ => Trouvé : 6 fois, Mis : 171 ms dont 15 ms uniquement pour les appels à PosBM_Mickey974Modif
Tant pis si ça ralentit un peut les recherches mais 500 millisecondes pour 1000000 recherches c'est supportable si on ne veut pas être enquiquiné avec les accents, les majuscules et les minuscules.
Mais on peut également envisager de n'utiliser PosBM_Mickey974Modif_ que pour des recherches qui distinguent les Majuscules des minuscules et de créer une variante qu'on n'utilise que pour des recherches qui Ignorent ces différences.
Cela donnerait deux routine qui pédaleraient à la même vitesse puisque dans les deux cas l'initialisation de la SkipTable s'effectue avant les boucles d'appel.
En tous cas je vais choisir cette dernière solution.
Cordialement, et à +.
15 juin 2015 à 14:00
>> "J'ai passé un WE ensoleillé au grand air sur le toit de ma maison pour y enlever la mousse!"
Entre les mousses et la tondeuse à gazon y a de quoi s'occuper (lol)
>> "Essayez ce test (je ne l'ai pas fait):
initialisez la table par défaut initBMH_sauts('')
puis utilisez la avec le test d'un mot (sans initialisation)?
Normalement c'est bon? (a petits pas)" :
Oui c'est bon, j'ai testé : tous les sauts sont à 1 : ça évite les plantages si on oublie d'initialiser la table mais avec des sauts de 1 on perd tout l'intérêt du Boyer-Moore.
Il serait peut-être plus simple de prévoir un if BMH_sauts[chr(0)]=1 then showmessage('Initialiser la table des sauts sinon ça va ramer') qui serait déclenché par un appel à PosBM_Mickey974Modif__()
Cordialement, et à +.
15 juin 2015 à 13:04
J'ai passé un WE ensoleillé au grand air sur le toit de ma maison pour y enlever la mousse!
Essayez ce test (je ne l'ai pas fait):
initialisez la table par défaut initBMH_sauts('')
puis utilisez la avec le test d'un mot (sans initialisation)?
Normalement c'est bon? (a petits pas)
J'ai remis un peu d'ordre dans nos échanges (il était temps), je placerai le tout dans une unité POaSm, en voici le début.
Pour la suite il me reste quelques vérifications à faire sur la pertinence des progs
à prendre comme modèle avant de sauter dessus à petits pas!
13 juin 2015 à 13:11
>> "...la table de sauts peut être initialisée par défaut comme suit : initBMH_sauts(''); à placer dans INITIALIZATION ce qui permet de ne pas planter la machine en cas de mauvaise utilisation." :
OK c'est prudent.
>> "Dans ce cas l'algo devient 'force brute' et peut s'utiliser comme tel pour des mots et phrases courtes" :.
Non car si on initialise uniquement avec initBMH_sauts('') c'est à dire avec LenSub = 0 tous les sauts seront nuls donc la recherche ne fonctionnera pas et se comportera comme une boucle sans fin.
>> Par contre comme la création de la table des sauts est 2 fois plus rapide en ASM qu'en Pascal il ne resterait plus qu'à convertir également en ASM la function PosBM_Mickey974Modif__(const Mot, Texte: string; var Depuis: integer): integer;
Cordialement, et à +.
13 juin 2015 à 11:39
Réponse à votre message de 17 heures 03 du 12 juin 2015 relatif à votre version ASM de la fabrique de table de sauts :
OK en ASM la création de la table des sauts est 2 fois plus rapide :
{A} initBMH Nombre de tests : 1000000 GetTickCount : 47
{B} initSkip2 Nombre de tests : 1000000 GetTickCount:78
Nombre de tests d'avance de {A} par rapport a {B}:397436
Cordialement, et à +.
13 juin 2015 à 10:54
Réponse à votre message de 16 heures 57 du 12 juin 2015
Il y a une embrouille dans :
InitSkip255 et InitSkip2 utilisent toutes deux tSkip2 = array[char] of byte; et dans InitSkip2 vous placez l'integer Lensub -k dans un byte.
En conséquence de ceci avec votre Mot de 258 caractères 'A' tous les sauts relatifs aux caractères autres que le 'A' sont réduits à 2 et 1 pour le 'A' vu le "tests initskip2" alors que le "tests initSkip255" affiche 255 pour tous les sauts relatifs aux caractères autres que le 'A'
Et comme les performances du Boyer-Moore augmentent lorsque la valeur des sauts augmentent votre test de vitesse en est complètement faussé.
Pour vous convaincre de cette erreur essayez donc ce bout de code :
... il affiche "LenSub : 258 Skip : 2"
Bon, je vais tester votre version ASM
Cordialement, et à +.
12 juin 2015 à 17:35
J'ai oublié un détail qui me semble intéressant : la table de sauts peut être initialisée par défaut comme suit : initBMH_sauts(''); à placer dans INITIALIZATION ce qui permet de ne pas planter la machine en cas de mauvaise utilisation. Dans ce cas l'algo devient 'force brute' et peut s'utiliser comme tel pour des mots et phrases courtes.
Salutations
Modifié par piette le 12/06/2015 à 17:37
Voici ma version ASM de la fabrique de table de sauts
A suivre
Les test donne 64 pour la version ASM et 101 pour la version Pascal
Salutations
12 juin 2015 à 16:57
Il n'est pas nécessaire de faire une table d'integer.
pour les mots < 256 char cela ne sert à rien.
pour des mots > 255 c'est certainement peu courant.
Pour résoudre ce problème il faut prendre en compte la modif de InitSkip2(ASubStr: string) qui ne plante JAMAIS et accepte toutes longueurs de mot
Pour ilustrer ceci je vous joint un programme test:
il utilise InitSkip2(ASubStr: string) en version origine
InitSkip255(ASubStr: string); avec mes modifs.
J'ai mis une fabrique de chaine que n'aime pas BMH pour mettre le coin dans la faille.
ensuite 2 tests
avec table de sauts InitSkip255 , résultat 3035 (grâce au saut de 255)
avec table de sauts InitSkip2 , résultat 18397 (des sauts de 2)( 258 MOD 256)
Vous verrez l'état des tables dans le test.
Je ne sais que dire de plus devant ce constat
Salutations
12 juin 2015 à 15:41
Là je suis perdu!
en 48c vous trouvez 151587081, ce qui est impossible sur 1 octet?
vous ne pouvez trouver que 0..255?
Salutations
12 juin 2015 à 10:04
>> "Vous avez remarquez que InitSkip2 avec la modif {B} plante? ":
Bin oui, mais ça vient de la déclaration de type tSkip2 = array[char] of byte; qu'il convient de remplacer par type tSkip2 = array[char] of integer;
Mais votre modif {A} FillChar(Skip2, 256, v); donne des résultats incorrects dont voici un extrait :
Alors qu'avec le code suivant :
... on a les résultats corrects suivants :
>> A propos de "..élargir la table à 2 octets va alourdir la lecture. " :
C'est le prix à payer si vous voulez utiliser la routine avec des LenSub > 255 mais le ralentissement est minime.
Cordialement, et à +.
12 juin 2015 à 00:25
Vous avez remarquez que InitSkip2 avec la modif {B} plante? car présence de 0.
l'initialisation des sauts à lenSub peut être 0 car la table est sur 1 octet.
exemple pour 256 512 etc soit lenSub modulo 256.
élargir la table à 2 octets va alourdir la lecture.
je vais prendre connaissance de toutes vos remarques.
Salutations
11 juin 2015 à 15:51
Voici une variante créée à partir de PosBM_Mickey974Modif qui renvoie en un seul appel toutes les Positions des occurrences de Mot dans Texte à partir de Depuis et jusqu'à la fin de Texte
Cordialement, et à +.
11 juin 2015 à 12:26
Vous m'aviez demandé "Essayez de tester BmhStrPos_ dans les conditions ci dessus pour voir ?" et j'avais mal compris.
Voici les résultats comparatifs pour :recherche de 123456789 dans 012345678901234567890123456789012345678901234567890123456789123
Pour nb-Recherches = 800000 :
- Avec PosBM_Mickey974D => Trouvé : 6 fois, Mis : 405 ms dont 265 ms uniquement pour les appels à PosBM_Mickey974D
- Avec PosBM_Mickey974Modif => Trouvé : 6 fois, Mis : 125 ms dont 47 ms uniquement pour les appels à PosBM_Mickey974Modif
- Avec BMHStrPos_ => Trouvé : 6 fois, Mis : 1981 ms dont 1918 ms uniquement pour les appels à BMHStrPos_
Conclusion : on peut laisser tomber BMHStrPos_ et PosBM_Mickey974D.
Code utilisé pour ce test :
Cordialement,et à +.
11 juin 2015 à 10:52
Vous dites
Sur 1° : FillChar doit initialiser toutes les valeurs des sauts dans un premier temps à LenSub ce qui fait qu'aucun saut ne peut être 0 si LenSub <> 0 et ceci concerne avant tout tous les caractères qui ne figurent pas dans la SubString
et dans un deuxième temps, pour les caractères qui figurent dans la Substring on corrige les sauts avec for k := 1 to Pred(LenSub) do Skip2[AnsiChar(ASubStr[k])] := LenSub - k; et là aussi la plus petite valeur de saut est 1 et jamais 0
Donc sur 1° je ne comprends pas ce que vous trouvez comme erreur.
Sur 2° : Si la SubString à plus de 255 caractères c'est forcément qu'elle contient un certain nombre de caractères identiques.
Et quelle que soit LenSub s'il y figure des caractère identiques comme le 'u' de Trucmuche le saut correspondant au 'u' est ici de 3, distance qui sépare le 'u' le plus proche du 'e' terminal, donc là aussi je ne comprends pas l'erreur que vous signalez.
Par contre vos remarques tombent à pic car il y a quand même une erreur :
Si LenSub > 255 alors tSkip2 ne peut être un array[char] of byte; mais un array d'integer :
Cordialement, et à +.
Modifié par piette le 10/06/2015 à 23:41
J'ai regardé le code Pos_Mickey974Modif.
-InitSkip2:
Il y a 2 erreurs:
1°) erreur : il est possible d'avoir une table de saut avec des zéros et c'est l'enlacement fatal voir //----plante le prog avec l'option {B}--- dans le test
2°) petite erreur si le mot à plus de 255 char la table de saut reçoit au dela de 255
zéro ou position du char modulo 256. ce qui plante ou fait des petits sauts.
PosBM_Mickey974Modif__:
la valeur de sortie est inférieure de 1.
si pas trouvé la valeur retournée est -1 je l'ai mise à zéro (comme pos delphi)
J'ai implanté Depuis pour trouver toutes les occurrences dans le texte.
voila:
10 juin 2015 à 16:28
>> "Essayez de tester BmhStrPos_ dans les conditions ci dessus pour voir?":
Si je le teste dans vos conditions on ne pourra pas comparer avec les autres.
>> "Je pense que le plus rapide( en m s) est de modifier posKR en 2 morceaux comme PosBm_Mickey974Modif et l'ajout de 'depuis' Le mieux placé pour cela est le créateur de posKR. Autrement je me lance dans le vide sidéral code." :
Sinon vous pouvez toujours convertir le code ci-dessous en PChar.
J'ai essayé à plusieurs reprises de convertir ce code en PChar pour s'approcher de la vélocité de l'ASM mais je me suis planté à chaque fois à cause de bugs incompréhensibles.
Cordialement, et à +.
Modifié par piette le 10/06/2015 à 16:14
Essayez de tester BmhStrPos_ dans les conditions ci dessus pour voir?
Edit=en seconde lecture je viens de comprendre que 'votre code du 9juin' est en fait le votre que j'ai bricolé, alors que je pensais a mon code ASM, d'où ma confusion.
Je pense que le plus rapide( en m s) est de modifier posKR en 2 morceaux comme PosBm_Mickey974Modif et l'ajout de 'depuis'
Le mieux placé pour cela est le créateur de posKR .
Un bon complément de tuto pour moi.
Autrement je me lance dans le vide sidéral code.
Salutations.
10 juin 2015 à 12:44
Pour illustrer le gain de vitesse obtenu en créant la Skip-Table une fois pour toutes avant les appels répétitifs aux routines Boyer-Moore voici les résultats d'un test comparatif obtenu cette fois-ci sans colorier le mots du RichEdit :
Recherche de 123456789 dans 012345678901234567890123456789012345678901234567890123456789123
Pour nb-Recherches = 800000 :
- Avec PosBM_Mickey974D => Trouvé : 6 fois, Mis : 421 ms dont 155 ms uniquement pour les appels à PosBM_Mickey974D
Pour nb-Recherches = 800000 :
- Avec PosBM_Mickey974Modif => Trouvé : 6 fois, Mis : 125 ms dont 61 ms uniquement pour les appels à PosBM_Mickey974Modif
Dans PosBM_Mickey974D la Skip-table est re-crée lors de chacun de 800000 appels tandis que les 800000 appels à PosBM_Mickey974Modif la Skip-table n'est crée qu'une seule fois avant les appels
Voici le code du test :
Peut-être qu'une variante PChar ou ASM de PosBM_Mickey974Modif serait plus véloce que le code Pascal actuel.
Cordialement, et à +.
10 juin 2015 à 11:28
>> "Je ne vois pas comment mettre le prog comme vous le faites donc recours au copié collé ci dessous" :
Cliquer sur <> juste ci-dessus à droite là où se trouve B I S <> cela place les balises code dans cette lucarne ensuite insérer votre code entre les <>
.
>> "J'ai modifié un peu BMHStrPos en y ajoutant Depuis et le dépannage de Cirec. vous pourrez le mettre en piste pour se mesurer avec les 2 précédents concurrents et voir comment se place votre code." :
Voici les résultats pour la recherche de 123456789 dix mille fois dans
012345678901234567890123456789012345678901234567890123456789123
- Avec PosBM_Mickey974Modif => Trouvé : 6 fois, Mis : 4712 ms pour nb-Recherches = 10000
- Avec PosKR => Trouvé : 6 fois : Mis : 4820 ms pour nb-Recherches = 10000
- Avec votre code du 9juin => Trouvé : 6 fois, Mis : 4789 ms pour nb-Recherches = 10000
Mais j'ai fait ce test comme suit pour vérifier en même temps par coloriage des mots dans le RichEdit 'Re' que la position des occurrences trouvées est correcte donc les 3 durées d'exécution incluent ces coloriages :
On remarque que les durées d'exécution (PosBM_Mickey974Modif : 4712 ms, PosKR : 4820 ms, et votre code du 9juin : 4789 ms) se tiennent dans un mouchoir de poche, cependant :
- si PosBM_Mickey974Modif qui n'est ni en PChar, ni en ASM est un peu plus rapide que les deux autres c'est certainement parce que j'initialise la Skip-Table une fois pour toutes avant d'appeler la routine PosBM_Mickey974 dans les boucles car si on cherche le même Mot dans un nombre N de textes différents il est inutile de re-créer la Skip-Table N fois puisque son contenu ne dépend que du Mot à trouver.
- et si PosKR qui est en ASM est la plus lente c'est pour deux raisons : 1) comme on ne peut lui passer le paramètre 'Depuis' je raccourcis la chaîne du texte avec un Copy pour trouver chaque occurrence suivante, et 2) elle re-crée la Skip-Table lors de chaque appel.
>>"D'autre part je suis allé visiter le site des fidèles et regarder posKR.
Cela m'a permis de mieux comprendre le fonctionnement de la table des sots" :
Bin oui, dans la Skip-table les valeurs de tous les sauts sont égaux à length(Mot) pour tous les caractères qui ne figurent pas dans le Mot c'est ce qui favorise l'avance rapide, et pour ceux qui y figurent la valeur du saut dépend de sa position dans le Mot et sa longueur.
Exemple recherche de :
Delphi
OxiDelphixyzd < dans le texte
Comme sous le i on a le l la valeur du saut est égale à 3 pour positionner le mot Delphi exactement à la place de celui du texte.
Cordialement, et à+.
Modifié par Cirec le 10/06/2015 à 12:24
Cirec minute est plus rapide que mon peugeot minute pour le dépannage, chapeau bas.
J'ai modifié un peu BMHStrPos en y ajoutant Depuis et le dépannage de Cirec.
vous pourrez le mettre en piste pour se mesurer avec les 2 précédents concurrents et voir comment se place votre code.
Je ne vois pas comment mettre le prog comme vous le faites donc recours au copié collé ci dessous.
D'autre part je suis allé visiter le site des fidèles et regarder posKR.
Cela m'a permis de mieux comprendre le fonctionnement de la table des sots.
Voici le prog:
Salutations
8 juin 2015 à 17:47
Dans la précipitation j'avais oublié de supprimer un sms('break') ainsi qu'un break dans le code d'utilisation de PosBM_Mickey974Modif(Mot, Texte, Depuis) : mille excuses, voici le code corrigé :
Cordialement, et à +.
8 juin 2015 à 17:11
>> Cirec : "Ex. pour la fonction Pos pas moins de 19 variantes sont testées" :
Là, du coup je suis submergé à mon tour !!!
Mais j'ai quand même téléchargé PosBV560.zip : merci
Cordialement, et à +.
8 juin 2015 à 16:59
>> Piette, vous dites "La fonction a été mise 2 fois en échec sur 5 tests (?). " :
J'ai également remarqué qu'elle déraillait parfois.
Par contre la solution de mon message du 7 juin 2015 à 14:21 qui utilise la routine en ASM de KR85 fonctionne bien en récupérant la routine de KR85 ici : http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=82390.
En plus de ceci j'ai également modifié la routine de Mickey974 que vous pouvez voir également sur le site de Phidels de façon à permettre des recherches à partir d'une position 'Depuis' et comme elle n'utilise pas d'ASM je vous la passe :
Les principales différences avec la source d'origine ont été :
- d'initialiser une fois pour toutes la Skip-Table (qui ne dépend que de la SubString) avec la routine procedure InitSkip2(ASubStr: string) ce qui évite de ré-initialiser cette table lors de chaque appel de la function PosBM_Mickey974Modif(.)
- et de lui passer en en plus le paramètre 'Depuis'.
(Comme je suis nul en ASM je n'ai donc pas fait la même chose avec la routine de KR85 et la solution de mon message du 7 juin 2015 à 14:21 ne repose donc que sur un pis-aller qui consiste à appeler la routine de KR85 dans une boucle dans laquelle je raccourcis la longueur du texte-cible, mais du coup on ajoute un Copy et en plus la skip-table est réinitialisée à chaque appel).
// Pour utiliser PosBM_Mickey974Modif(...,Depuis) :
Cordialement, et à +.
8 juin 2015 à 16:52
8 juin 2015 à 14:48
Vous me fournissez beaucoup de lecture je suis submergé! Merci
Après révision de mon tuto j'ai essayé de comprendre l'algo, que j'ai trouvé plus compliqué que prévu (par moi).
Ensuite j'ai fait quelques test pour voir les réactions, en utilisant ceci:
procedure testBM(Const pTex, pMot: PChar);
var R : Pchar;
begin
R:=StrPos(pTex,pMot); // c'est la function que vous m'avez prêté
if R = NIL then R:='???';
writeln('[',pMot,'] ---> [',pTex,'] = [',R,']');
end;
begin
// Insérer le code utilisateur ici
testBM('-11-110','-11');
testBM('111-110','-11');
testBM('1111-110','-11'); //------> Résultat=NIL ????
testBM('11111-110','-11');//------> Résultat=NIL ????
testBM('111111-110','-11');
readln;
end.
La fonction a été mise 2 fois en échec sur 5 tests (?).
Je ne sais pas trop pourquoi, comme vous maitrisez cela bien plus que moi je vous laisse regarder avant d'essayer en ASM
A bientôt.
Salutations.
8 juin 2015 à 14:45
je constate que vous avez fini par trouver la balise de code ^^
trêve de plaisanteries ... je suis très content de voir qu'il y a encore des membres actifs et qui osent se lancer dans de type de challenge ;)
enfin un peu de vie sur CS_Delphi ... rien que pour ça je vous dis Bravo et Merci.
juste pour information: les fonctions Pos & PosEx de Delphi (et bien d'autres encore) sont issues du FastCode Challenge Project
sur la gauche de la page vous y trouverez la liste des fonctions Delphi traitées dans ce challenge et bien sûr le plus important, les sources
- Ex. pour la fonction Pos pas moins de 19 variantes sont testées
et logiquement tous les vainqueurs ont intégrés la RTL de Delphi
... il y a encore d'autres choses à voir sur le site ... ;)
bien sûr tout ceci n'empêche pas de trouver ou d'explorer d'autres pistes ... bien au contraire
on l'a tous fait ... rien de mieux pour apprendre et à tous niveaux
Bonne continuation et surtout ne lâchez rien
7 juin 2015 à 14:21
Comme KR85 m'a rappelé que le Boyer-Moore a été implémenté de plusieurs façons et en ASM ici : http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=82390
mais avec des fonctions du type POSXY(SubStr, Str : string):integer; donc sans passage de votre paramètre 'Depuis' je vous signale que l'on peut néanmoins utiliser la function POSKR(SubStr, Str : string):integer; register; de KR85 dans une boucle pour trouver les positions des occurrences successives en raccourcissant la Str cible avent chaque appel suivant :
Résultats pour :
Mot := '123456789'
Texte := '012345678901234567890123456789012345678901234567890123456789123'
Trouvé : 6 fois Avec PosKR : Mis : 4789 ms pour nb-Recherches = 10000
Trouvé : 6 fois Avec Pos ASM de Piette : Mis : 6349 ms pour nb-Recherches = 10000 (1,32 fois plus lente)
Cordialement, et à +.
6 juin 2015 à 18:14
Voici à toutes fins utiles une version basique sans PChar d'une StrPos à la mode Boyer-Moore simplifié :
On trouve sur le net des variantes de Boyer-Moore plus compliquées qui utilisent des SkipTables.
Cordialement, et à +.
6 juin 2015 à 12:17
>> "Il est évident que votre proposition sera plus rapide à l'exécution" :
C'est bien ce que je pense car.cela évite de ralentir avec des tests inutiles.
Cela fonctionne comme un pochoir.dans lequel on perce la SubString et qu'on place sur le Texte à la position Depuis et tant qu'on ne voit pas au travers du dernier caractère du pochoir un caractère du Texte qui lui est égal on déplace le pochoir d'un pas égal à length(SubString) donc une avance à grands pas.
Par contre dès qu'il y a égalité sur le dernier caractère du pochoir on passe dans une deuxième boucle où l'on marche à reculons pour vérifier si l'égalité se propage jusqu'au premier caractère de pochoir et :
- si oui on a trouvé la position de la première occurrence et la fonction retourne
cette position,
- si non on déplace le pochoir d'un pas égal à length(SubString) et on passe
dans la première boucle dans laquelle on ne teste que le dernier caractère.
>> "Je révise mon tuto et vais reprendre le code. Je trouve qu'il est plus facile en ASM de tout reconstruire plutôt que de modifier." :
C'est souvent vrai aussi dans les autres cas.
>> "Dès que ce sera au point je reviens vers vous" :
OK, merci.
.
>> "Merci pour votre algo que je ne connaissais pas" :
De rien et en plus l'algo ne m'appartient pas je me suis contenté d'en faire une version PChar.en simplifiant à l'extrême.
Cordialement, et à +.
Modifié par Cirec le 8/06/2015 à 13:36
b, c'est étrange bien sûr mais j'ai eu des difficultés pour poster une réponse!
Voici l'algo utilisé par l'ASM:
Il est évident que votre proposition sera plus rapide à l'exécution.
Je révise mon tuto et vais reprendre le code. Je trouve qu'il est plus facile en ASM
de tout reconstruire plutôt que de modifier.
Dès que ce sera au point je reviens vers vous.
Merci pour votre algo que je ne connaissais pas.
Piette
3 juin 2015 à 12:43
Tu dis "C'est pas certain; car cette façon de traiter est proche du raisonnement de l'ASM" : le problème c'est que tant qu'on n'a pas essayé on reste dans l'incertitude.
Par contre, si le code de Piette est une traduction ASM de l'algo basique, il est certain qu'une traduction ASM de l'algo Boyer-Morre sera plus rapide que la version ASM de l'algo basique, je pense qu'on est d'accord sur ce point, car il avance à grands pas dans les textes où la SubString est absente.
Cordialement, et à +.
3 juin 2015 à 12:24
"Je pense qu'en ASM cela devrait donc être plus rapide qu'en PChar."
C'est pas certain; car cette façon de traiter est proche du raisonnement de l'ASM.
Modifié par Cirec le 8/06/2015 à 13:34
J'ai testé ton code qui marche à merveille.
Mais comme je suis nul en ASM je me permets de poser une question à propos de sa vitesse d'exécution :
Quel est le type d'algo à la base du code ? Car dans le cas où il s'agirait d'un algo basique qui compare TOUS les caractères de la SubString à ceux du texte-cible dans TOUTES les positions successives de la SubString il serait possible d'augmenter notablement la vitesse d'exécution en utilisant un algo à la façon Boyer-Moore qui se contente de ne comparer que le Dernier de la SubString à celui du texte-cible et qui avance d'un pas égal à la longueur de la SubString en cas de différence et qui ne compare les autres caractères de la SubString qu'en cas d'égalité avec le dernier caractère de la SubString. En bref, la vitesse d'exécution d'un algo Boyer-Moore augmente en fonction de la longueur de la SubString et de la longueur des zones du texte où cette SubString est absente, tandis qu'un algo basique pédale dans la choucroute à effectuer un nombre considérable de comparaisons inutiles.
A toutes fins utiles, voici une version PChar de StrPos de l'algo Boyer-Moore :
Je pense qu'en ASM cela devrait donc être plus rapide qu'en PChar.
Cordialement, et A+.
31 mai 2015 à 20:10
Salutations
31 mai 2015 à 18:06