Commentaires sur une source : Amélioration de la fonction Pos()

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
15 sept. 2015 à 20:04

voici un exemple:
pour l'unité voir :
http://codes-sources.commentcamarche.net/source/view/101168/1380817


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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
1 sept. 2015 à 22:46

Bonsoir,
Les baignades sont terminées, hélas.

Salutations.

Rekin85 Messages postés 25 Date d'inscription dimanche 11 décembre 2011 Statut Membre Dernière intervention 17 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 ?

Merci beaucoup

cs_pseudo3
17 juil. 2015 à 09:42

Bonjour,

>> "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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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.

cs_pseudo3
Modifié par cs_pseudo3 le 13/07/2015 à 12:05

Re-bonjour,

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 à +.

cs_pseudo3
13 juil. 2015 à 11:47

Bonjour,

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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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);

implementation
uses classes, shellApi, windows, _posDJ;


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;

end.

j'ai ajouté ceci:
procedure init_TreBMH2C(var BM : TreBMH2C);

cs_pseudo3
12 juil. 2015 à 09:57

Bonjour,

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!

2000000 trouvailles en ---------------78 ms

MOT : Bon
len V2C.texte : 380

4000000 trouvailles en ---------------125 ms

Cordialement, et à +.

cs_pseudo3
10 juil. 2015 à 11:12

Bonjour,

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('');

  Trace(V2C.mot);

  ShowMessage('ici 1'); //<<<<<<<<<<<<<<<<<<<<<<<<<<<

  if Fab_sauts(V2C) then
  begin
    ShowMessage('ici 2'); //<<<<<<<<<<<<<<<<<<<<<<<<<<<

    //visualise_table(V2C);
    Trace('len V2C.texte : '+ intToStr(length(V2C.texte)));

    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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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

cs_pseudo3
8 juil. 2015 à 11:47

Re-salut,

Puis pour tester, ce serait sympa de donner un bout de code qui montre comment utiliser l'unit BMH2C.

Cordialement, et +.

cs_pseudo3
Modifié par cs_pseudo3 le 8/07/2015 à 11:03

Bonjour,

>> "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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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);

implementation
uses classes, shellApi, windows, _posDJ;


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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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és 25 Date d'inscription dimanche 11 décembre 2011 Statut Membre Dernière intervention 17 octobre 2015
1 juil. 2015 à 22:13

Voir ici :

http://www.developpez.net/forums/d1530223/environnements-developpement/delphi/algorithme-boyer-moore/

Rekin85 Messages postés 25 Date d'inscription dimanche 11 décembre 2011 Statut Membre Dernière intervention 17 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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
30 juin 2015 à 18:13

bonjour,
cela viendra!
salutations

cs_pseudo3
30 juin 2015 à 17:42

Re-salut,

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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 30/06/2015 à 15:52

Il y a un problème ici:


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;

cs_pseudo3
30 juin 2015 à 11:12

Bonjour,

>> "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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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;

Salutations

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 29/06/2015 à 23:42

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

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

cs_pseudo3
29 juin 2015 à 11:31

Re-salut,

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.

Cordialement, et à +.

cs_pseudo3
29 juin 2015 à 10:35

Bonjour,

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 :

JZ     @Ya?  //<***********************************************modification faite ici

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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 28/06/2015 à 17:59

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;

end.

cs_pseudo3
28 juin 2015 à 17:23

Re-salut,

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 à +.

cs_pseudo3
28 juin 2015 à 16:47

Bonjour,

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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

cs_pseudo3
28 juin 2015 à 12:58

Bonjour,

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 à +.

cs_pseudo3
28 juin 2015 à 12:52

Re-bonjour,

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 à +.

cs_pseudo3
28 juin 2015 à 11:45

Bonjour,

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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 28/06/2015 à 11:29

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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
27 juin 2015 à 16:59

Bonjour,
Merci pour les compliments,
c'est un plaisir partagé d'avoir confronté nos programmes.
Bonnes vacances.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 27/06/2015 à 16:53

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';

var v2c : T2chars;
    I,N: integer;
    D,J : Cardinal;
    SubSTR , STR : 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
  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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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 !!!

Sur ce ... bonne journée et
@+ Cirec

cs_pseudo3
27 juin 2015 à 12:09

Bonjour,

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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 27/06/2015 à 00:05

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

cs_pseudo3
26 juin 2015 à 15:51

Re-salut,

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 à +.

cs_pseudo3
26 juin 2015 à 14:58

Re-salut,

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;

Cordialement, et à +.

cs_pseudo3
26 juin 2015 à 14:26

Bonjour,

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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}

cs_pseudo3
25 juin 2015 à 18:12

Re-Bonjour,

>> "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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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;

  result := lpPerformanceCount;
End;

cs_pseudo3
Modifié par Cirec le 25/06/2015 à 12:36

Bonjour,

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;

Coridalement, et à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par Cirec le 25/06/2015 à 12:35

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.

Bonne suite
Bon tests.

cs_pseudo3
24 juin 2015 à 16:08

Bonjour,

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 à +.

piette
24 juin 2015 à 14:28

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

cs_pseudo3
24 juin 2015 à 11:45

Bonjour,

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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 ;)

@+ Cirec

cs_pseudo3
21 juin 2015 à 11:13

Bonjour,

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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']));

Teste déjà ça pour voir si ça corrige le problème

@+ Cirec

cs_pseudo3
20 juin 2015 à 17:32

Bonjour,

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 à +.

cs_pseudo3
20 juin 2015 à 15:46

Re-salut,

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.

Cordialement, et à +.

cs_pseudo3
20 juin 2015 à 13:05

Re-salut,

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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 :(

@+ Cirec

cs_pseudo3
20 juin 2015 à 09:48

Bonjour,

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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par Cirec le 20/06/2015 à 11:48

Le code ASM

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.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par Cirec le 20/06/2015 à 11:48

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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'

@+ Cirec

cs_pseudo3
19 juin 2015 à 11:03

Bonjour,

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 à +.

cs_pseudo3
18 juin 2015 à 16:23

Bonjour,

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;

Cordialement, et à +.

cs_pseudo3
17 juin 2015 à 17:05

Re-salut,

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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

@+ Cirec

cs_pseudo3
17 juin 2015 à 12:41

Re-bonjour,

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".

Cordialement, et à +.

cs_pseudo3
17 juin 2015 à 10:39

Bonjour,

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 à +.

cs_pseudo3
17 juin 2015 à 10:38

Bonjour,

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 à +.

cs_pseudo3
17 juin 2015 à 10:36

Bonjour,

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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
17 juin 2015 à 00:30

ReBonsoir,
Je pense qu'il serait moins fastidieux de placer votre table MNA dans un string?
Salutations

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 16/06/2015 à 23:41

Bonjour,
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

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 16/06/2015 à 15:38

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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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 ^^

voilà ... dites moi comment ça tourne chez vous

@+ Cirec

cs_pseudo3
16 juin 2015 à 12:02

Bonjour,

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é :

const MNA : array[Char] of Char // Majuscules et minuscules Non Accentués
             =  #0#1#2#3#4#5#6#7#8#9#10#11#12#13#14#15 +
                #16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31 +
                ' !"#$%&''()*+,-./0123456789:;<=>?' +
                '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_' +
                '`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~'#127 +
                '€'#129''f"...+#^0/00S<OE'#141'Z'#143#144'`'""*---~(TM)S>OE'#157'ZY' +
                #160'¡¢£¤¥¦§¨©ª«¬*®¯°±²³'µ¶·¸¹º»¼½¾¿' +
                'AAAAAAÆCEEEEIIIIDNOOOOO×OUUUUYÞß' +
                'AAAAAAÆCEEEEIIIIDNOOOOO÷OUUUUYÞY';

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;

Cordialement, et à +.

cs_pseudo3
15 juin 2015 à 15:39

Re-salut,

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;

Cordialement, et à +.

cs_pseudo3
15 juin 2015 à 15:03

Re-bonjour,

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.

Cordialement, et à +.

cs_pseudo3
15 juin 2015 à 14:00

Bonjour,

>> "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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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!


unit POaSm;

interface

Type TBMH_sauts = array[char] of Byte;

procedure initBMH_sauts(Const SubStr : string; var TS : TBMH_sauts); register; overload;

procedure initBMH_sauts(Const SubStr : string); register; overload;

implementation

var  BMH_sauts : TBMH_sauts;

//-----------------------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;

procedure initBMH_sauts(Const SubStr : string); register; overload;
asm
  LEA EDX,BMH_sauts
  CALL __initBMH_sauts;
end;

INITIALIZATION
initBMH_sauts('');  //BMH -> force brut (sécurité pour éviter 0 dans table)

end.

Salutations

cs_pseudo3
13 juin 2015 à 13:11

Re-salut,

>> "...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 à +.

cs_pseudo3
13 juin 2015 à 11:39

Re-salut,

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 à +.

cs_pseudo3
13 juin 2015 à 10:54

Bonjour,

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 :

procedure TForm1.SpeedButton2Click(Sender: TObject);
var SubStr: string; Skip : byte; LenSub: integer;
begin
  SubStr:=StringOfChar('A',258);
  LenSub:=length(SubStr);
  Skip:=LenSub;
  showMessage('LenSub : '+intToStr(LenSub)+' Skip : '+ intToStr(Skip));
end;

... il affiche "LenSub : 258 Skip : 2"

Bon, je vais tester votre version ASM

Cordialement, et à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 12/06/2015 à 17:37

RE Bonjour,
Voici ma version ASM de la fabrique de table de sauts
A suivre


program BMH_ASM;
{$APPTYPE CONSOLE}
uses sysutils,windows;

//---------------------------BMH------------------------------------------------

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).
}

procedure initBMH_sauts(Const SubStr : string {var TS : TBMH_sauts}); register;
{ EAX=ptr(SubSTR) EDX=ptr(T)?}

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------------------------BMH------------------------------------------------


//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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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

cs_pseudo3
12 juin 2015 à 10:04

Bonjour,

>> "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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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

cs_pseudo3
11 juin 2015 à 15:51

Re-salut,

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;

Cordialement, et à +.

cs_pseudo3
11 juin 2015 à 12:26

Re-salut,

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 :

procedure TForm1.bMikeyAvecSansClick(Sender: TObject);
var Mot, Texte, TR: string; LM, LT, Depuis, Po: integer; skip: tSkip2;
  GTC1, GTC2, Mis, nbTours, Count: longWord;
var Poc, pText: PChar;
begin
  Mot := '123456789';
  Texte := '012345678901234567890123456789012345678901234567890123456789123';
  LM := length(Mot); LT := length(Texte);
  nbTours := 800000;

  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;

Cordialement,et à +.

cs_pseudo3
11 juin 2015 à 10:52

Bonjour,

Vous dites

"-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;

Cordialement, et à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 10/06/2015 à 23:41

Bonsoir,
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:


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;

//  writeln('trouve ',PosBM_Mickey974Modif__(SubStr,Scible,D));
  writeln('---------------------------------------');

  //------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.

cs_pseudo3
10 juin 2015 à 16:28

Re-salut,

>> "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;

Cordialement, et à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par piette le 10/06/2015 à 16:14

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.

cs_pseudo3
10 juin 2015 à 12:44

Re-salut,

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 :

procedure TForm1.bMikeyAvecSansClick(Sender: TObject);
var Mot, Texte, TR: string; LM, LT, Depuis, Po: integer; skip: tSkip2;
  GTC1, GTC2, Mis, nbTours, Count: longWord;
begin
  Mot := '123456789';
  Texte := '012345678901234567890123456789012345678901234567890123456789123';
  LM := length(Mot); LT := length(Texte);
  nbTours := 800000;

  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.

Cordialement, et à +.

cs_pseudo3
10 juin 2015 à 11:28

Bonjour,

>> "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.

Cordialement, et à+.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par Cirec le 10/06/2015 à 12:24

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;

procedure IncAvecMax(var quoi : integer; Max1,ouMax2 : integer); register;
begin
  //if Max1 > ouMax2 then ouMax2:=Max1;
  //inc(quoi,ouMax2);
  asm //EAX=ptr[quoi] EDX=Max1 ECX=ouMax2
     CMP  EDX,ECX
     JG   @x      // EDX > ECX
     MOV  EDX,ECX
  @x:ADD  [EAX],EDX // inc quoi
  end;
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;


var Texte,Mot : string;  D,I, N: integer;  R: Pchar; GTC: longWord;

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.

Salutations

cs_pseudo3
8 juin 2015 à 17:47

Re-salut,

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;

Cordialement, et à +.

cs_pseudo3
8 juin 2015 à 17:11

Bonjour,

>> 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 à +.

cs_pseudo3
8 juin 2015 à 16:59

Bonjour,

>> 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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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és 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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

Bonne continuation et surtout ne lâchez rien

@+ Cirec

cs_pseudo3
7 juin 2015 à 14:21

Bonjour,

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)

Cordialement, et à +.

cs_pseudo3
6 juin 2015 à 18:14

Re-bonjour,

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.

Cordialement, et à +.

cs_pseudo3
6 juin 2015 à 12:17

Bonjour et merci pour votre réponse,

>> "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 à +.

piette Messages postés 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 juin 2019
Modifié par Cirec le 8/06/2015 à 13:36

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

cs_pseudo3
3 juin 2015 à 12:43

Bonjour René,

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 à +.

Rekin85
3 juin 2015 à 12:24

Salut Gilbert
"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.

cs_pseudo3
Modifié par Cirec le 8/06/2015 à 13:34

Bonjour,

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és 68 Date d'inscription jeudi 11 décembre 2008 Statut Membre Dernière intervention 16 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és 25 Date d'inscription dimanche 11 décembre 2011 Statut Membre Dernière intervention 17 octobre 2015
31 mai 2015 à 18:06

Content que mon petit tuto sur l'Asm avec Delphi t'ai incité à produire du code performant...

Amélioration de la fonction Pos()

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

Votre réponse

Discussions similaires