CHAINES: ENLEVER LES ACCENTS ET COMPTER LE NOMBRE D'OCCURENCES D'UNE LETTRE , Source N°29245

Information sur la source

Catégorie :Texte Niveau : Débutant Date de création : 02/02/2005 Date de mise à jour : 02/02/2005 15:05:59 Vu / téléchargé: 9 673 / 567

Auteur : florenth

Site perso

Ecrire un message privé

Note :

10,00 / 10

1
2
3
4
5
6
7
8
9
10

Commentaire sur cette source (8)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Comme le dit le titre, ce code vous montre comment récupérer le nombre d'occurences de la lettre la plus présente dans une chaine et permet d'enlever les accents d'une chaine.

Cette source, san aucune prétention, a été crée en reponse à une question du forum mais elle peut etre utile pour tous.

Conclusion

Ma fonction de suppression des accents consiste à regarder si chaque caractere fait partie d'une constante et si oui, de le remplacer par le caractere du même index de l'autre constante.

Grandvizir a déjà posté une source contenant une fonction similaire mais elle est bien plus lente.
Voici les temps obtenus pour 105000 caracteres :

Ma fonction : 47 ms.
Celle de Grandvizir : 266 ms.
Donc ma fonction est plus de 5.5 fois pus rapide que celle de Grandvizir.

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Manipler chaines
- Project1.dpr 188 octets
- Unit1.dfm2 419 octets
- Unit1.pas 2 322 octets

Télécharger le zip

Historique

02 février 2005 15:05:59 :: Ajout de la capture qui n'avais pas marché

Sources du même auteur

Toutes les sources de florenth

Sources de la même categorie

Toutes les sources de la catégorie Texte

Commentaires

Commentaire de grandvizir le 02/02/2005 15:55:23

?
Commentaire de architect le 02/02/2005 16:11:48

Je te remercie pour ta rapidité et ton efficacité à faire cela !
Merci encore pour ton aide !

Pour la peine, je te donne un petit dix ^_^
Commentaire de grandvizir le 02/02/2005 16:15:34

Je viens de piger le truc...
http://www.delphifr.com/forum.v2.aspx?ID=381569
Je me demande d'ailleurs si ce lien n'est pas plus intéressant que... trois petits points...
Commentaire de florenth le 02/02/2005 16:43:45

Oui tu as peut-être raison grandvizir.
Je vais reprendre les idees citées dans ce sujet pour donner une explication plus approfondie ....

architect > De rien. J'espere que cela aura résolu ton problème.

@ ++ Flo
Commentaire de architect le 02/02/2005 16:48:15

Je te dirai cela ce week-end car je ne suis pas chez moi actuellement, mais promis je regarde de plus prés et puis je te dis cela !

Par contre un epetite question : quelle est la fonction "FillChar" qui est utilisé pour tout initialiser à zéro ?
Commentaire de Delphiprog le 02/02/2005 18:55:57 administrateur CS

C'est net, propre, efficace et rapide, si j'ai bien compris.

Bravo florenth.
Commentaire de Fred_Ca_Pulse le 15/03/2006 14:59:09

Bonjour à tous, moi aussi je propose ma contribution pour supprimer les accents :

function AccentsSupprimer( const SChaine : String ) : String;
const
     SAccents    =  'àäâãçéèêëìïîôöòûüùÿÁÀÄÂÃÉÈÊËÍÎÌÔÖÒÓÕÜÛÙÚÝ';
     SSansAccents = 'aaaaceeeeiiiooouuyyAAAAAEEEEIIIOOOOOUUUUY';
var
   ILong : Longint;
   Source, Dest : PChar;
   Source2Init, Dest2Init, Source2, Dest2 : PChar;
   ILongSource, I : Longint;
   CCaractere, CDestination : Char;
begin
     // Init de la chaîne
     ILong := Length( SChaine );
     SetLength( Result, ILong );
     Source := Pointer( SChaine );
     Dest := Pointer( Result );
     // Init de la recherche / remplacement
     Source2Init := SAccents;
     Dest2Init := SSansAccents;
     ILongSource := Length( SAccents );
     // Recherche / remplacement
     while ILong <> 0 do begin
           CCaractere := Source^;
           CDestination := CCaractere;
           Source2 := Source2Init;
           Dest2 := Dest2Init;
           I := ILongSource;
           while I <> 0 do
                 if CCaractere = Source2^ then
                    begin // Remplacement
                    CDestination := Dest2^;
                    Break;
                    end
                 else
                    begin // Suivant
                    Inc( Source2 );
                    Inc( Dest2 );
                    Dec( I );
                    end;
           // Avancement
           Dest^ := CDestination;
           Inc( Source );
           Inc( Dest );
           Dec( ILong );
     end;
end;

D'après mes tests elle est environ 4 fois plus rapide que la fonction initiale proposée.
... mais bien sûr un peu plus longue.
... on peut peut-être faire encore mieux :)

FRED
Commentaire de f0xi le 29/04/2006 07:49:30 administrateur CS

petite amelioration

pour 100 000 requettes :

Florenth methode : ~1500ms(0.0140 < 0.0162 ms/r)
Fred methode     : ~375ms (0.0035 < 0.0038 ms/r)
ma mienne        : ~90ms  (0.0007 < 0.0009 ms/r)

de plus elle prend en compte un plus large eventail de caracteres accentués...

function RemoveAcute(const S: string): string;
var
  PResult : PChar;
  PStr    : PChar;
begin
  Result  := S;
  PResult := PChar(Result);
  PStr    := PChar(S);
  while PStr[0] <> #0 do begin
    case PStr[0] of
       #192..#197 : PResult[0] := 'A';
       #199       : PResult[0] := 'C';
       #200..#203 : PResult[0] := 'E';
       #204..#207 : PResult[0] := 'I';
       #209       : PResult[0] := 'N';
       #210..#214 : PResult[0] := 'O';
       #138       : PResult[0] := 'S';
       #217..#220 : PResult[0] := 'U';
       #159,#221  : PResult[0] := 'Y';
       #142       : PResult[0] := 'Z';
       #224..#229 : PResult[0] := 'a';
       #231       : PResult[0] := 'c';
       #232..#235 : PResult[0] := 'e';
       #236..#239 : PResult[0] := 'i';
       #241       : PResult[0] := 'n';
       #242..#246 : PResult[0] := 'o';
       #154       : PResult[0] := 's';
       #249..#252 : PResult[0] := 'u';
       #253,#255  : PResult[0] := 'y';
       #158       : PResult[0] := 'z';
    end;
    inc(PResult);
    inc(PStr);
  end;
end;

directement inspiré d'exemple donnés par Florenth lui meme.