Remove spaces in sentence

procedure TForm1.Button1Click(Sender: TObject);
const txt='The    cat     sat   on   the         mat' ;
var ln:string;
begin
 ln:=txt;
 while pos('  ',ln)>0 do
   ln:=Stringreplace(ln,'  ',' ',[rfreplaceall]);
 showmessage(ln);
end;

Limbeck,  
            Sorry forgot to mention that this is required for a very old project compiled under Delphi 3 (StringReplace not available in Delphi 3). I can not use a newer version of Delphi because of some components that are used that I don't have the source code for.

Thanks
Paul.

function SubstituteSpaces(sIn : string) : string;
var
  i : Integer;
begin
  i := 1;
  whilei i < Length(sIn) do
  begin
    if sIn[i] <> ' ' then
    begin
      Result := Result + sIn[i];
      Inc(i);
      Continue;
    end;
    Result := Result + ' ';
    while (sIn[i] = ' ') and (i < Length(sIn)) do
      Inc(i);
  end;
end;

ok, changed it to

procedure TForm1.Button1Click(Sender: TObject);

const txt='The    cat     sat   on   the         mat' ;
var ln:string;
     i:integer;
begin
 ln:=txt;
 i:=1;
 while i<length(ln)-1 do
 begin
   If (Ln[i]=' ') and (Ln[i+1]=' ') then
     ln:=copy(ln,1,i-1)+Copy(Ln,i+1,length(ln)-i+1)
   else
     i:=i+1;
 end;
 showmessage(ln);
end;

Why reinvent the wheel?
Just take the code from delphi 6 and use it in your own.

type
  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

This code should have a slightly better performance :-)

function StripMultipleSpaces(const Value: string): string;
var
  I, J: Integer;
begin
  Result := Value;
  I := Pos(#32#32, Result);
  if (I > 0) then
  begin
    repeat
      Inc(I);
      J := Succ(I);
      while (J <= Length(Result)) and (Result[J] = #32) do
        Inc(J);
      while (J <= Length(Result)) do
      begin
        if (Result[Pred(I)] = #32) then
        begin
          while (J <= Length(Result)) and (Result[J] = #32) do
            Inc(J);
        end;
        if (J <= Length(Result)) then
        begin
          Result[I] := Result[J];
          Inc(I);
          Inc(J);
        end;
      end;
    until (J > Length(Result));
    SetLength(Result, Pred(I));
  end;
end;

1). using copy addes a lot of overhead when it comes to performance :)
2) rmeeres solution is nice but again from performance point of view it consumes "too much" memory :D

here is my version (not necessarely the best):

function removeextra(s:String):string;
var i:integer;
begin
  i:=1;
  while i<=length(s) do
  begin
    while (i<=length(s)) and (s[i]<>' ') do
      i:=i+1
    i:+i+1
    while (i<=length(s)) and (s[i]=' ') do
      delete(s,i,1);// I don't know excatly how badly this affects performance. it could be calculated.
  end;
  result:=s;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  showmessage(removeextra('The    cat     sat   on   the         mat' ));
end;

so from performance point of view, my solution might be better, at least at first look :D, but it could be slower then rmeeres solution. I would do a performance test on it but I lack my toys (read units) here and am too lazy to google for one :P

The answer chosen boggles the mind ciuly but I suppose the question was how to do it rather than how to do it best. :)

If you take my solution and change the Inc with i + 1 it runs a bit faster but still use a few bytes memory more than yours, but with memory size where it is right now I don't think anyone will miss 1 byte per character of the example sentence.

rmeere you are right in both aspects.
the solution was probably choose because it was the first one :)
and nowadays, performance issues for such problems are usually just put to please the mind or to race as the hardware these days is just too powerfull for the user to feel any difference like the ones that arise from these examples.

I am actually amazed that the chosen solution actually worked! If you look at the code then you'll notice that S1 is NEVER initialized. Thus it could point to some random data instead of an empty string.
Also funny is how this function actually keeps updating the value of Edit2.Text every time a space is encountered in the string. And this accidently works since at the beginning an additional space has been added to the string.
Of course, the many concatenations inside it are also slowing it down. Which isn't bad for a single string of e.g. 40 characters or so but if you have to go through 500 MB of text then you could definitely increase performance by NOT using this solution...

Anyway, if it seems to work for the questioneer, fine... :-)

Btw, based on memory and speed, I'd win... :-P

*grin*@Alex

 why dont you test all sollutions with a 500mb file? just for fun?

You would propably win Alex, but your solution assumes there will always be a combination of 2 spaces and not a random number as indicated by the author.

I would agree with you assesment about the answer. Updating the edit box adds a LOT of overhead

hmm not as much overhead since there isnt a repaint or a processmsg

alex .. I'm not sure on the speed thing. on memory you sure do not win as you start up with 2 strings of 500mb where as I start with one of 500mb :P
and in regards to speed, you have a lot more calls to other procedures which also affect performance negativly so I am really interested in a comoparison since I am not sure on teh speed of teh string delete procedure. but if that is fairly fast ...

so what do you say? a pack of beer? or some 20 points? :P
https://www.experts-exchange.com/questions/21980883/Performance-contest.html

Actually, rmeere, my solution DOES assume there can be a random number of spaces. All I do at the start is find the first occurrance in the string where there are two (or more) spaces. I can then start removing them from that point. (And if it can't find two spaces, it doesn't even need to do anything!)

@ciuly, in this case I created a function which returns a string. If I had used a procedure with a VAR parameter then I would not even need to copy the original string. Thus, with a string of 500 MB all I would need is those 500 MB plus a bit more for the counters...

Interesting challenge, btw. :-)

Btw, the only procedures that I call several times are length, inc, Pred, Succ which aren't really a lot. Of course I could store Length(Result) in a variable called Max and then replace the other occurrances of Length(Result) with Max. That would mean a lot less function calls. :-)
And now something funny. Test my code in the CPU window. :-) You will see that the function inc() is replaced with a single assembler instruction. :-) Actually, I see almost no 'call' statements in the disassembler for this piece of code. The only call that is made is to UniqueStringA which happens in the Result[I] := Result[J]; line.

So, it's pretty fast... :-)

good points :)
still, waiting for your input in the contest ;) you seem to have more experience than I do at such stuff, as I only started thinking performance about 1 year ago.