program test_del_empty;
{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}
uses
Classes, SysUtils, DateUtils, StrUtils, LGUtils, LGStrHelpers;
type
TTestProc = function: TStringList;
var
CurrProc: string = '';
const
TestFile = 'data.txt';
procedure RemoveEmptyLinesMax(aList: TStringList);
var
I: Integer = 0;
begin
while I < aList.Count do
if aList[I] = '' then
aList.Delete(I)
else
Inc(I);
end;
function DelEmptyLinesMax: TStringList;
begin
CurrProc := {$I %currentroutine%};
Result := TStringList.Create;
Result.LoadFromFile(TestFile);
RemoveEmptyLinesMax(Result);
end;
procedure RemoveEmptyLinesBart(aList: TStringList);
var
I: Integer;
begin
for I := Pred(aList.Count) downto 0 do
if aList[I] = '' then
aList.Delete(I);
end;
function DelEmptyLinesBart: TStringList;
begin
CurrProc := {$I %currentroutine%};
Result := TStringList.Create;
Result.LoadFromFile(TestFile);
RemoveEmptyLinesBart(Result);
end;
procedure RemovEmptyLinesThaddy(aList: TStringList);
var
a: array of string;
begin
a := aList.Text.Split(LineEnding, TStringSplitOptions.ExcludeEmpty);
aList.Clear;
aList.AddStrings(a);
end;
function DelEmptyLinesThaddy: TStringList;
begin
CurrProc := {$I %currentroutine%};
Result := TStringList.Create;
Result.LoadFromFile(TestFile);
RemovEmptyLinesThaddy(Result);
end;
procedure RemoveEmptyLinesWinny(aList: TStringList);
var
s: string;
p: integer = 1;
begin
s := aList.Text;
repeat
p := posEX(LineEnding + LineEnding, s, p);
if p > 0 then
delete(s, p, length(lineEnding));
until p = 0;
aList.Text := s;
end;
function DelEmptyLinesWinny: TStringList;
begin
CurrProc := {$I %currentroutine%};
Result := TStringList.Create;
Result.LoadFromFile(TestFile);
RemoveEmptyLinesWinny(Result);
end;
procedure RemoveEmptyLinesAvk(aList: TStringList);
var
sb: specialize TGAutoRef<TStringBuilder>;
function NonEmpty(constref s : string): Boolean;begin Result := s <> '' end;
procedure Add(constref s: string); begin with sb.Instance do begin
Append(s); Append(LineEnding) end end;
begin
aList.GetEnumerable.Select(@NonEmpty).ForEach(@Add);
aList.Text := sb.Instance.ToString;
end;
function DelEmptyLinesAvk: TStringList;
begin
CurrProc := {$I %currentroutine%};
Result := TStringList.Create;
Result.LoadFromFile(TestFile);
RemoveEmptyLinesAvk(Result);
end;
function DelEmptyLinesJamie: TStringList;
procedure RemoveEmptyLines(var S: TMemorystream);
var
R,W,ST:Pchar;
CC,LEC:Integer;
L:char;
Begin
If (S = Nil)or(S.Size=0) then Exit;
R := PChar(S.Memory);
W := R;
ST := W;
While R^<>#0 do
Begin
CC := 0; //Char Count;
While Not (R^ in [#13,#10,#0]) do //Move line content if any
Begin
W^ := R^;
Inc(R); Inc(W);
Inc(CC); //Char count
End;
If CC <> 0 Then
Begin
LEC := 0; //Line Ending Count
L := #0; //Last char in line ending.
While (R^ in [#13,#10])and(L <> R^)And(LEC<2) Do //Move the Line Ending if Valid content.
Begin
L := R^; //Update the last Line ending type incase we have single types.
Inc(LEC);
W^:= R^;
Inc(R);
Inc(W);
end;
End
Else
While (R^ in [#13,#10]) Do Inc(R); // Skip over blanks.
End;
W^ := #0; // Terminate the end;..
end;
var
S:TMemoryStream;
begin
CurrProc := {$I %currentroutine%};
S := TMemoryStream.Create;
S.LoadFromFile(TestFile);
S.Seek(0,soFromEnd);
S.WriteByte(0);
RemoveEmptyLines(S); // The real work horse;
Result := TStringList.Create;
Result.Text := string(S.Memory);
S.Free;
end;
function DelEmptyLinesEgsuh: TStringList;
var
f: TextFile;
s: string;
begin
CurrProc := {$I %currentroutine%};
Result := TStringList.Create;
AssignFile(f, TestFile);
Reset(f);
while not eof(f) do begin
Readln(f, s);
if trim (s) <> '' then Result.Append(s);
end;
CloseFile(f);
end;
function NonEmptyCount(aList: TStringList): Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to Pred(aList.Count) do
Inc(Result, Ord(aList[I] <> ''));
end;
function HasEmptyLines(aList: TStringList): Boolean;
var
I: Integer;
begin
for I := 0 to Pred(aList.Count) do
if aList[I] = '' then
exit(True);
Result := False;
end;
const
TestSize = 200000;
LineSize = 16;
function CreateStringList: TStringList;
function RandomString: string;
var
I: Integer;
p: PChar;
const
AlphabetLen = 64;
Alphabet: PChar = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_ ';
begin
SetLength(Result, LineSize);
p := PChar(Result);
for I := 0 to Pred(LineSize) do
p[I] := Alphabet[Random(AlphabetLen)];
end;
var
I: Integer;
begin
RandSeed := 1001007;
Result := TStringList.Create;
Result.Capacity := TestSize;
for I := 1 to TestSize do
if Random(5) <> 0 then
Result.Add(RandomString)
else
Result.Add('');
end;
var
Proc: TTestProc = nil;
Start: TTime;
Elapsed, TestCount: Integer;
TestList: TStringList;
const Procs: array of TTestProc = (
@DelEmptyLinesMax, @DelEmptyLinesBart, @DelEmptyLinesThaddy, @DelEmptyLinesWinny,
@DelEmptyLinesAvk, @DelEmptyLinesJamie,@DelEmptyLinesEgsuh);
begin
TestList := TStringList.Create;
TestList.LoadFromFile(TestFile);
TestCount := NonEmptyCount(TestList);
TestList.Free;
for Proc in Procs do
begin
Start := Time;
TestList := Proc();
Elapsed := MillisecondsBetween(Time, Start);
if HasEmptyLines(TestList) or (TestList.Count <> TestCount) then
Writeln(CurrProc, #9'elapsed time(ms): ', Elapsed, ' (failure)')
else
Writeln(CurrProc, #9'elapsed time(ms): ', Elapsed);
TestList.Free;
end;
end.
Recent
