Discussion :

[Manopower]

Bonjour j'aimerais savoir combien il y a de points '.' dans la variable S:='192.168.16.1';

[Edit]Je pourrais le faire en faisant une boucle en testant chaque caractère, mais si il y avait une fonction toute prête que je n'aurais pas vue... [/edit]

Merci d'avance, et désolé si j'ai zappé la réponse dans la FAQ

[e-ric]

Salut

Alors une petite faiblesse ? ;-)

A ma connaissance, il n'y a pas de telle fonction dans la VCL (pour D6, néanmoins je ne la connais pas par coeur, honte à moi).

Pour le fun, si tu ne cherche que des caractères (tu l'aurais bien trouvé toi-même mais je ne peux m'en empêcher) et non pas une sous-chaîne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
function StrCharCount(Str: String; C: Char) : Integer;
var
   I: integer;
begin
  Result := 0;
  for I := 1 to length(Str) do
    Inc(Result, Ord(Str[I]=C));
  // for
End;

Pour passer à la recherche de sous-chaîne, il serait appréciable d'avoir une routine Pos qui admette un paramètre supplémentaire indiquant la position de départ de la recherche (0 pour commencer puis la première position trouvée +1 et ainsi de suite), on pourrait alors facilement faire des recherches successives.

cdlt

e-ric

[Manopower]

je ne sais pas si tu as eu le temps de lire mon edit, mais effectivement j'avais trouvé en faisant une boucle, mais ça ne fonctionne que pour les caractères.

La fonction pos qui accepte un autre paramètre s'appelle PosEx 8)

Moi non plus je ne connais pas la VCL par coeur, mais effectivement je n'ai pas trouvé de routine qui fait ce que je veux toute seule, alors bouclons, comme on a trouvé tous les deux !

[e-ric]

Merci pour le tuyau (PosEx)

Il semble que cette fonction n'existe pas dans D6 (la version à ma disposition sur mon lieu de travail).

bonne soirée et bonne boucle...

e-ric

[Hauwke]

Salut,

un vieux truc d'archive:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
function split(input:string;schar:char;s:integer):string;
    var
         i,n:integer;
         schop: string;
    begin
         n := 1;
         for i := 1 to length(input) do
         begin
         if (input[i] = schar) then
         begin
             inc(n);
             if n = s then
             split := schop
             else
             schop := '';
             end
         else
             schop := schop + input[i];
         end;
    end;

Rajoute un TStrinlist et ça doit faire la rue Michel, non?
En comptant le nombre de souschaîne -2 (1 pour le count) tu as le nombre de séparateur et aprés tu fais ce que tu veux des sous chaînes
Nota: je ne suis pas l'auteur de ce bout de code mais j'arrive pas à me rappeler de son nick, donc rendons grace à tous ces illustres inconnus qui peuplent nos source! RIRES
Cordialement, Hauwke

[Hauwke]

De mes vieux sources, je viens d'extraire une unité qui implémente les fonctions suivantes (marchent depuis Delphi3 et + je crois)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
function RightTrim(const s:String):String;
function LeftTrim(const s:String):String;
function InStr(Start: integer; Source: string; SourceToFind: string): integer;
function Mid(Source: string; Start: integer; Length: integer): string;
function Left(Source: string; Length: integer): string;
function Right(Source: string; Lengths: integer): string;
function Replace(sData: String; sSubstring: String; sNewsubstring: string): String;
function Split(Source, Deli: string; StringList: TStringList): TStringList;
function Reverse(Line: string): string;

Si ça vous interresse, donnez moi une adresse email en message privé et je vous l'envoie
Cordialement, Hauwke

[petitcoucou31]

Voila une routine que j'utilise , qui compte le nombre de sous chaine dans une chaine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Function NbOcc(Source,Occ:string):integer;
var p:integer;
begin
    result:=0;
    while AnsiPos(Occ,Source)<>0 do
    begin
        P:=AnsiPos(Occ,Source);
        delete(Source,1,P);
        inc(result)
    end;
end;

bye

[Manopower]

Merci, voilà qui serait utile de figurer dans la FAQ !

[Bloon]

Si la recherche concerne uniquement un caractère, cette solution est très couteuse, il vaut mieux parcourir la chaine une fois :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
// Renvoie le nombre d'occurrences du caractère 'c' dans la chaine 's'
function nbOccurrences(const c : char; const s : string) : integer;
var
  p : PChar;
begin
  result := 0;
  p := PChar(s);
  while (p^ <> #0) do
  begin
    if (p^ = c) then
      inc(result);
    inc(p);
  end;
end;

Bloon

[Manopower]

la solution de petitcoucou31 mérite d'être dans la FaQ effectivement uniquement si la sous-chaîne est sur plusieurs caractère.
Bloon, je trouve la tienne un peu complexe, quelle différence y a t il avec celle que j'ai finalement écrite ? (en consdérant que je sais rajouter un paramètre pour le caractère recherché)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
function TEditAdresseIP.NbPoints(Chaine: String): Integer;
var
 i : Integer;
begin
  //Pour empêcher de tapper un 4ème point
    result:=0;
    For i:=1 to length(Chaine) do
      if Chaine[i]='.' then
        inc(result);      //On compte le nb de points
 
end;

[Bloon]

la solution de petitcoucou31 mérite d'être dans la FaQ effectivement uniquement si la sous-chaîne est sur plusieurs caractère.
Bloon, je trouve la tienne un peu complexe, quelle différence y a t il avec celle que j'ai finalement écrite ? (en consdérant que je sais rajouter un paramètre pour le caractère recherché)

A priori, c'est plus rapide de passer par un pointeur, c'est juste une question de performance. Je dis à priori car je n'ai pas mesuré :-)

Bloon

[Manopower]

J'ai fait chauffer mon PC avec le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
function NbPoints(Chaine: String; SousChaine : Char): Integer;
function nbOccurrences(const c : char; const s : string) : integer;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
function NbPoints(Chaine: String; SousChaine : Char) : Integer;
var
 i : Integer;
begin
    result:=0;
    For i:=1 to length(Chaine) do
      if Chaine[i]=SousChaine then
        inc(result);      //On compte le nb de points
 
end;
 
// Renvoie le nombre d'occurrences du caractère 'c' dans la chaine 's'
function nbOccurrences(const c : char; const s : string) : integer;
var
  p : PChar;
begin
  result := 0;
  p := PChar(s);
  while (p^ <> #0) do
  begin
    if (p^ = c) then
      inc(result);
    inc(p);
  end;
end;
 
procedure TForm1.BTestClick(Sender: TObject);
var
  LongueChaine : String;
  Start : TTime;
  i,j,nb : integer;
begin
  LongueChaine := '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!';
 
//Premier test avec pointeurs (méthode de bloon)
Gauge1.Progress:=0;
Start:= now;
For j := 1 to 35000 do
begin
  Gauge1.Progress:=j;
  For i := 1 to 35000 do
  begin
    Application.ProcessMessages;
    nb := nbOccurrences('b',LongueChaine);
  end;
end;
LblAvecPointeurs.caption:=TimeToStr(Now-Start);
 
//Second test sans pointeurs, (méthode de Sylvain)
Gauge2.Progress:=0;
Start:= now;
For j := 1 to 35000 do
begin
  Gauge2.Progress:=j;
  For i := 1 to 35000 do
  begin
    Application.ProcessMessages;
    nb := NbPoints(longuechaine,'b');
  end;
end;
LblSansPointeurs.caption:=TimeToStr(Now-Start);
 
 
end;

Le résultat affiché Avec Pointeurs = 00:21:00
Le résultat affiché sans Pointeurs = 00:16:09

Sans rien faire d'autres sur la machine (la nuit) pour ne pas impacter les performances.

J'aime bien faire des tests

Bonne journée !

[Bloon]

J'avais cette impression à cause de certaines fonctions de la VCL qui sont écrites avec des pointeurs et non des accès directs aux strings, je pensais donc que c'était plus rapide.

Maintenant je me ferai plus avec des pointeurs :-)

Bloon

[e-ric]

Salut

C'est assez curieux en effet, cela montre que le compilateur met en oeuvre des optimisations poussées mais pas toujours "lisibles". Le passage de paramètres en const explique peut-être des choses. Ceci dit, j'aurais pensé ce passage de paramètre plus performant.

Cependant, j'estime le test biaisé, en effet, l'expression des algorithmes est bien différentes (quoique, on ne voit pas l'assembleur généré). Mais le passage des paramètres l'est aussi ce qui peut favoriser l'un des algorithmes au détriment de l'autre. Donc... à revoir.

En outre, as-tu activé l'optimisation, le contrôle des limites au moment de la compilation ?

cdlt

e-ric

[Eric.H]

Maintenant je me ferai plus avec des pointeurs :-)

Pas si vite...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
function NbPoints(Chaine: String; SousChaine : Char) : Integer;
var
 i : Integer;
begin
    result:=0;
    For i:=1 to length(Chaine) do
      if Chaine[i]=SousChaine then
        inc(result);      //On compte le nb de points
 
end;
 
// Renvoie le nombre d'occurrences du caractère 'c' dans la chaine 's'
function nbOccurrences(const c : char; const s : AnsiString) : integer; overload;
var
  p : PChar;
begin
  result := 0;
  p := PChar(s);
  while (p^ <> #0) do
  begin
    if (p^ = c) then
      inc(result);
    inc(p);
  end;
end;
 
function nbOccurrences(const c : char; const s : ShortString) : integer; overload;
var
  Longueur:Byte;
  i_Car:Byte;
begin
  result := 0;
  IF s[0]=#0 THEN Exit;
  FOR i_Car:=1 TO ord(s[0]) DO
    BEGIN
      IF s[i_Car]=c THEN inc(Result);
    END;
end;
 
procedure TForm3.Button1Click(Sender: TObject);
var
  LongueChaine : String;
  Start : DWORD;
  i,j,nb : integer;
begin
  LongueChaine := '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!';
 
//Premier test avec pointeurs (méthode de bloon)
Start:= GetTickCount;
  For i := 1 to 3500000 do
  begin
    nb := nbOccurrences('b',LongueChaine);
  end;
LblAvecPointeurs.caption:=IntToStr(GetTickCount-Start)+'  nb='+IntToStr(nb);
 
//Second test sans pointeurs, (méthode de Sylvain)
Start:= GetTickCount;
  For i := 1 to 3500000 do
  begin
    nb := NbPoints(longuechaine,'b');
  end;
LblSansPointeurs.caption:=IntToStr(GetTickCount-Start)+'  nb='+IntToStr(nb);;
 
 
end;

J'ai refait le test qui me semblait "étrange"

Primo la version avec pointeur ne fonction qu'avec les "Chaines vaste" d'ou la modif du code en mettant ansistring et l'overload pour MA version chaine "courte"
Secundo j'ai virer le progressbar

N.B. Les resultat dependent des options compilateurs
A= : Resultat avec pointeur
B= : Resultat sans pointeur

les resultat en "chaine vaste":
Avec optimisation et toute les vérifications :
A=3822 B=5683

Sans optimisation et toute les vérifications :
A=5307 B=6723

Avec optimisation et aucune vérifications :
A=3703 B=4130

Donc dans tous les cas la version pointeur est plus rapide


les resultat en "chaine courte":
Dans ce cas, on n'utilise pas la version pointeur mais MA version de nbOccurrences qui est en overload
Avec optimisation et toute les vérifications :
A=2969 B=5922

Presque deux fois plus rapide

Pour chaque resultat une moyenne a été faite sur 3 tests

[e-ric]

Ouf, les pointeurs sont sauvés (non mais des fois)...

e-ric

[Manopower]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
function nbOccurrences(const c : char; const s : ShortString) : integer; overload;
var
  Longueur:Byte;
  i_Car:Byte;
begin
  result := 0;
  IF s[0]=#0 THEN Exit;
  FOR i_Car:=1 TO ord(s[0]) DO
    BEGIN
      IF s[i_Car]=c THEN inc(Result);
    END;
end;

Cette fonction ne ressemble plus beaucoup à celle que j'ai utilisée dans mes tests d'où les résultats différents ! Concernant la progressbar, comme elle est présente dans les 2 tests, je ne vois pas l'impact. Pareil pour les options de compilations, comme ce sont les mêmes dans les deux cas, il n'y a pas d'impact ? Je vais refaire des tests, ça me parait louche que nos résultats soient si différents (même si les fonctions utilisées ne sont plus du tout les même)

[Eric.H]

Cette fonction ne ressemble plus beaucoup à celle que j'ai utilisée dans mes tests d'où les résultats différents !

Pour la fonction, c'est normal la version "Pointeur" ne fonctionne que avec les AnsiString (option compilateur "Chaines vastes"). J'ai simplement fait une version ShortString n'utilisant pas les pointeurs. Tous les resultat Chaines vastes (utilisant la version "Pointeur" de la fonction) sont plus rapide. Le resultat sans chaines vastes et également plus rapide.
Pour ce qui est du progress bar, je l'ai simplement retire car d'aucune utilité pour le test.

Donc : Si l'option du compilateur "Chaines vastes" et cochée, on utilise exactement les même fonctions.

[oceane]

Plus court ... mais pas forcément plus performant...

Bonjour,
Un petit exemple "juste" pour le faire sans boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
function tform1.occurences(machaine:string ;cherche : string):integer;
var s:string;
begin
s:=machaine;
s:=StringReplace(s, cherche, '',[rfReplaceAll]);
occurences := (length(machaine)-length(s)) div length(cherche);
end;

[Manopower]

Je viens de refaire des tests, et loin de m'opposer à vos résultats, je cherche à comprendre pourquoi je n'ai pas les même que vous (j'ai utiliser ma fonction et pas la version modifiée que vous avez faite pour vos tests)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
function NbPoints(Const SousChaine : Char; Const Chaine: ShortString) : Integer;
var
 i : Integer;
begin
    result:=0;
    For i:=1 to length(Chaine) do
      if Chaine[i]=SousChaine then
        inc(result);      //On compte le nb de points
 
end;
 
// Renvoie le nombre d'occurrences du caractère 'c' dans la chaine 's'
function nbOccurrences(const c : char; const s : string) : integer;
var
  p : PChar;
begin
  result := 0;
  p := PChar(s);
  while (p^ <> #0) do
  begin
    if (p^ = c) then
      inc(result);
    inc(p);
  end;
end;
 
procedure TForm1.BTestClick(Sender: TObject);
var
  LongueChaine : ShortString;
  Start : Integer;
  i,j,nb : integer;
begin
  LongueChaine := '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!'+
                  '123Bb456Cb789:b12345bbbb!';
 
//Premier test avec pointeurs (méthode de bloon)
Start:= GetTickCount;
For j := 1 to 20 do
begin
  For i := 1 to 35000 do
  begin
    nb := nbOccurrences('b',LongueChaine);
  end;
end;
LblAvecPointeurs.caption:=IntToStr(GetTickcount-Start);
 
//Second test sans pointeurs, (méthode de Sylvain)
Start:= GettickCount;
For j := 1 to 20 do
begin
  For i := 1 to 35000 do
  begin
    nb := NbPoints('b',longuechaine);
  end;
end;
LblSansPointeurs.caption:=IntToStr(GetTickcount-Start);
 
 
end;

Résultats sur 10 tests : (test1;test2;test3 etc...)
Avec pointeurs : 968 ; 958 ; 969 ; 969 ; 969 ; 969 ; 1000 ; 1016 ; 969 ; 984 ;
Sans pointeurs : 438 ; 437 ; 437 ; 437 ; 453 ; 437 ; 438 ; 453 ; 422 ; 438 ;

Si je modifie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function NbPoints(Const SousChaine : Char; Const Chaine: ShortString) : Integer;

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function NbPoints(Const SousChaine : Char; Const Chaine: String) : Integer;

Les résultats sont moins tranchants, mais restent nettement en faveur du "sans pointeurs"

Avec pointeurs : 1015 ; 1000 ; 1000 ; 1000 ; 1000 ; 968 ; 1000 ; 1000 ; 1047 ; 1000 ;
Sans pointeurs : 750 ; 750 ; 750 ; 766 ; 750 ; 766 ; 781 ; 766 ; 781 ; 766 ;

Soi pour le même type de variable, la fonction utilisant les pointeurs est 25% plus lente.