Count

[Janilabo]

Returns the amount of S found in STR. Example included.

 

Count

[scar]function Count(s, str: string): Integer;

var

i, sL, strL: Integer;

begin

sL:= Length(s);

strL := Length(str);

if (sL <= strL) then

for i := 1 to ((strL - sL) + 1) do

if (Copy(str, i, sL) = s) then

Inc(Result);

end;

 

var

s, str: string;

 

begin

ClearDebug;

str := '|||| Count() Test ||| *** ||| Smooth. ||||';

s := '||';

WriteLn('Count of "' + s + '" in string: ' + IntToStr(Count(s, str)) + '!');

end.[/scar]

 

Count2

[scar]function Count2(s, str: string): Integer;

var

p: Integer;

begin

if (Length(s) <= Length(str)) then

repeat

p := PosEx(s, str, (p + 1));

if (p > 0) then

Inc(Result);

until (p <= 0);

end;

 

var

s, str: string;

 

begin

ClearDebug;

str := '|||| Count() Test ||| *** ||| Smooth. ||||';

s := '||';

WriteLn('Count of "' + s + '" in string: ' + IntToStr(Count(s, str)) + '!');

end.[/scar]

Edited May 22, 2012 by Janilabo

[FHannes]

I already intended to add a function like this to SCAR in 3.34 as I recently had a need for it, but this would be a lot more efficient with Pos + PosEx

[Janilabo]

Hopefully you'll add the function in SCAR in the future then..

 

I suggested it to Mantis earlier this month (http://bug.scar-divi.com/view.php?id=101), there is also a version that works with PosEx, but the thing is.. The function seems to work faster with Copy, maybe its just the method's I used.. I am sure you can improve this function!

 

-Jani

[FHannes]

http://wiki.scar-divi.com/index.php?title=CountStr

[Janilabo]

Nice job Freddy! So glad to see it's now added to SCAR. Woohoo!

 

Btw, here is some timing of the functions:

 

[scar]function Count(s, str: string): Integer;

var

i, sL, strL: Integer;

begin

sL:= Length(s);

strL := Length(str);

if (sL > strL) then

Exit;

for i := 1 to ((strL - sL) + 1) do

if (Copy(str, i, sL) = s) then

Inc(Result);

end;

 

function Count2(s, str: string): Integer;

var

p: Integer;

begin

if Length(s) <= Length(str) then

repeat

p := PosEx(s, str, (p + 1));

if p > 0 then

Inc(Result);

until p <= 0;

end;

 

function CountStr(const SubStr, Str: string): Integer;

var

StrPos, StrLen: Integer;

begin

Result := 0;

StrLen := Length(SubStr);

if (StrLen = 0) then

Exit;

StrPos := 1;

repeat

StrPos := PosEx(SubStr, Str, StrPos);

if (StrPos > 0) then

begin

Inc(Result);

IncEx(StrPos, StrLen);

end else

Break;

until False;

end;

 

function CountStr2(const SubStr, Str: string): Integer;

var

StrPos, StrLen: Integer;

begin

StrLen := Length(SubStr);

if (StrLen = 0) then

Exit;

StrPos := Pos(SubStr, Str);

if (StrPos > 0) then

begin

Result := 1;

while True do

begin

StrPos := PosEx(SubStr, Str, (StrPos + StrLen));

if (StrPos > 0) then

Inc(Result)

else

Break;

end;

end else

Result := 0;

end;

 

function GrabFileData(FileName: string): string;

var

f: Integer;

begin

if not FileExists(FileName) then

Exit;

f := OpenFile(FileName, False);

ReadFileString(f, Result, FileSize(f));

CloseFile(f);

end;

 

var

t: Integer;

str: string;

 

begin

str := GrabFileData(Replace(AppPath, 'bin\', '') + 'changelog.txt');

t := GetSystemTime;

WriteLn('CountStr: ' + IntToStr(CountStr(' ', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

t := GetSystemTime;

WriteLn('CountStr2: ' + IntToStr(CountStr2(' ', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

t := GetSystemTime;

WriteLn('Count: ' + IntToStr(Count(' ', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

t := GetSystemTime;

WriteLn('Count2: ' + IntToStr(Count2(' ', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

str := '';

end.[/scar]

 

Some more testing, seems like PosEx is definitely the best method to use with Count:

 

[scar]function Count(s, str: string): Integer;

var

i, sL, strL: Integer;

begin

sL:= Length(s);

strL := Length(str);

if (sL > strL) then

Exit;

for i := 1 to ((strL - sL) + 1) do

if (Copy(str, i, sL) = s) then

Inc(Result);

end;

 

function Count2(s, str: string): Integer;

var

p: Integer;

begin

if Length(s) <= Length(str) then

repeat

p := PosEx(s, str, (p + 1));

if p > 0 then

Inc(Result);

until p <= 0;

end;

 

function CountStr(const SubStr, Str: string): Integer;

var

StrPos, StrLen: Integer;

begin

Result := 0;

StrLen := Length(SubStr);

if (StrLen = 0) then

Exit;

StrPos := 1;

repeat

StrPos := PosEx(SubStr, Str, StrPos);

if (StrPos > 0) then

begin

Inc(Result);

IncEx(StrPos, StrLen);

end else

Break;

until False;

end;

 

function CountStr2(const SubStr, Str: string): Integer;

var

StrPos, StrLen: Integer;

begin

StrLen := Length(SubStr);

if (StrLen = 0) then

Exit;

StrPos := Pos(SubStr, Str);

if (StrPos > 0) then

begin

Result := 1;

while True do

begin

StrPos := PosEx(SubStr, Str, (StrPos + StrLen));

if (StrPos > 0) then

Inc(Result)

else

Break;

end;

end else

Result := 0;

end;

 

function GrabFileData(FileName: string): string;

var

f: Integer;

begin

if not FileExists(FileName) then

Exit;

f := OpenFile(FileName, False);

ReadFileString(f, Result, FileSize(f));

CloseFile(f);

end;

 

var

t: Integer;

str: string;

 

begin

str := GrabFileData(Replace(AppPath, 'bin\', '') + 'changelog.txt');

t := GetSystemTime;

WriteLn('CountStr: ' + IntToStr(CountStr('re', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

t := GetSystemTime;

WriteLn('CountStr2: ' + IntToStr(CountStr2('re', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

t := GetSystemTime;

WriteLn('Count: ' + IntToStr(Count('re', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

t := GetSystemTime;

WriteLn('Count2: ' + IntToStr(Count2('re', str)) + ' [' + IntToStr(GetSystemTime - t) + ' ms.]');

str := '';

end.[/scar] CountStr, CountStr2, Count2 are much faster than Count with that test. So yeah.

Edited May 22, 2012 by Janilabo