Stef Merlijn
asked on
Replace multiple blanks in string to one blank
Hi there,
I have a string which is build up like this:
This is a string
I need to remove all redundant blanks in this string. So if the string contains more then one blank (space) in a row, they should be decreased to one. This situation can occure multiple times in the same string. The result should be:
This is a string
Please provide me with a function to accomplish this.
The solution with the smallest code gets the points.
Thanks a lot, Stef
I have a string which is build up like this:
This is a string
I need to remove all redundant blanks in this string. So if the string contains more then one blank (space) in a row, they should be decreased to one. This situation can occure multiple times in the same string. The result should be:
This is a string
Please provide me with a function to accomplish this.
The solution with the smallest code gets the points.
Thanks a lot, Stef
procedure TForm1.Button1Click(Sender : TObject);
function MyTrim(const S: string): string;
var
I, L: Integer;
A: String;
got: Boolean;
begin
A := '';
L := Length(S);
for i := 1 to L do begin
If (S[I] <> ' ') then
begin
Got := False;
A := a + s[i];
end else
If not Got then
Begin
a := a+ ' ';
Got := True;
end;
end;
Result := A;
end;
begin
Label1.Caption := MyTrim('This is a string');
end;
function MyTrim(const S: string): string;
var
I, L: Integer;
A: String;
got: Boolean;
begin
A := '';
L := Length(S);
for i := 1 to L do begin
If (S[I] <> ' ') then
begin
Got := False;
A := a + s[i];
end else
If not Got then
Begin
a := a+ ' ';
Got := True;
end;
end;
Result := A;
end;
begin
Label1.Caption := MyTrim('This is a string');
end;
my version:
function RemoveRedundantSpaces(cons t S: string): string;
var
sList: TStringList;
i: Integer;
begin
sList := TStringList.Create;
Result := '';
with sList do
try
Text := StringReplace(S, ' ', #13, [rfReplaceAll]);
for i := 0 to Count - 1 do
if Strings[i] <> '' then
Result := Result + Strings[i] + ' ';
Result := Trim(Result);
finally
Free;
end;
end;
to use it:
Label1.Caption := RemoveRedundantSpace('This is a string');
function RemoveRedundantSpaces(cons
var
sList: TStringList;
i: Integer;
begin
sList := TStringList.Create;
Result := '';
with sList do
try
Text := StringReplace(S, ' ', #13, [rfReplaceAll]);
for i := 0 to Count - 1 do
if Strings[i] <> '' then
Result := Result + Strings[i] + ' ';
Result := Trim(Result);
finally
Free;
end;
end;
to use it:
Label1.Caption := RemoveRedundantSpace('This
note:
shortest note doesn't mean most efficient ;-)
shortest note doesn't mean most efficient ;-)
PS: Of course, neither was I saying that mine was the most efficient :-p
This routine will strip out all of the multiple spaces in the string in only one pass (unlike the shorter but less efficient "StringReplace" example).
function StripMultiSpaces( const AString:string ):string;
var
Index:integer;
OnSpace:boolean;
begin
Result := '';
OnSpace := False;
for Index := 1 to Length(AString) do begin
if (AString[Index] = ' ') then begin
if not OnSpace then Result := Result + AString[Index];
end else begin
Result := Result + AString[Index];
end; {if}
OnSpace := (AString[Index] = ' ');
end; {for}
end;
function StripMultiSpaces( const AString:string ):string;
var
Index:integer;
OnSpace:boolean;
begin
Result := '';
OnSpace := False;
for Index := 1 to Length(AString) do begin
if (AString[Index] = ' ') then begin
if not OnSpace then Result := Result + AString[Index];
end else begin
Result := Result + AString[Index];
end; {if}
OnSpace := (AString[Index] = ' ');
end; {for}
end;
Oops, Ferruccio68's algorithm is pretty much the same as the one I just posted (his uses more local variables though).
Hi,
My version:
function RemoveRedundantSpaces(cons t S: string): string;
var
Len: integer;
i,j: integer;
Former: char;
begin
result := S;
Len := Length(S);
Former := S[1];
j := 2;
for i := 2 to Len do begin
if (S[i] = ' ') then begin
if (not (Former = ' ')) then begin
result[j] := S[i];
Inc(j);
end;
end else begin
result[j] := S[i];
Inc(j);
end;
Former := S[i];
end;
SetLength(result, j);
end;
Regards, Geo
My version:
function RemoveRedundantSpaces(cons
var
Len: integer;
i,j: integer;
Former: char;
begin
result := S;
Len := Length(S);
Former := S[1];
j := 2;
for i := 2 to Len do begin
if (S[i] = ' ') then begin
if (not (Former = ' ')) then begin
result[j] := S[i];
Inc(j);
end;
end else begin
result[j] := S[i];
Inc(j);
end;
Former := S[i];
end;
SetLength(result, j);
end;
Regards, Geo
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
It is quite important that the function is fast too ofcourse.
So a onepass through the string is very much appreciated.
So a onepass through the string is very much appreciated.
My solution is ten times faster than the accepted one :-(
ehhh Geo, that's the life :)))
F68 ;-)
F68 ;-)
...the accepted answer also tramples off the end of the string if you give it a single character. That said, it isn't really an issue as it only tramples onto the #0 terminating the string.
F68, your function is the second best of the six. Testing agains huge strings my function becomes more than 50 times faster compared to the accepted one.
Best regards,
Best regards,
I see geo, and i agree with you, but you and me know how to test and choose the best one. Maybe he did like the accepted one just for the 'less code' without give a try to every posted code...
Every man is different from each other man, that's why i said 'that's the life' :)))
F68 ;-)
Every man is different from each other man, that's why i said 'that's the life' :)))
F68 ;-)
Sure, F68. I put effords on testing because Delphiwizard said:
>It is quite important that the function is fast too ofcourse.
and posted the results of the tests for the eventual future readers ;-)
>It is quite important that the function is fast too ofcourse.
and posted the results of the tests for the eventual future readers ;-)
ASKER
The reason that I choose this one is probably because it worked fine and it has not to many lines of code.
If the other code of geobul is faster, that I don't know.
If I was smart enough to think of the proposed solutions and be able to determine which is faster then it probably would have chosen different. I try to choose better next time.
Thanks anyway for your input.
If the other code of geobul is faster, that I don't know.
If I was smart enough to think of the proposed solutions and be able to determine which is faster then it probably would have chosen different. I try to choose better next time.
Thanks anyway for your input.
S, Temp: string;
begin
// S contains string to reduce
Temp := S;
repeat
S := Temp;
Temp := StringReplace(S, ' ', ' ', [rfReplaceAll]);
until S = Temp;
end;