| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как удалить все пробелы в строке. [D7, XP]

Cerberus ©   (2006-05-22 20:05:00) 

сабж

---

Loginov Dmitry   (2006-05-23 19:54:00) [1]

Amoeba ©   (23.05.06 10:55) [13]

Не впечатлило :) Дельфи все-равно быстрее:

function FastDeleteSpaces(S: String): String;
var
 I, Counter: Integer;
 C, C1: PChar;
begin
 SetLength(Result, Length(S));
 Counter := 0;
 C := PChar(S);
 C1 := PChar(Result);
 for I := 1 to Length(S) do
 begin
   if C^ <> ' ' then
   begin
     C1^ := C^;
     Inc(C1);
     Inc(Counter);
   end;
   Inc(C);
 end;
 SetLength(Result, Counter);
end;

---

Gydvin   (2006-05-23 12:46:00) [2]

> функция Q_DelChar из библиотеки QStrings, она на asm'е.

Интересная юнита, респект ))

---

Amoeba   (2006-05-23 10:55:00) [3]

function Q_DelChar(const S: string; Ch: Char): string;
asm
       PUSH    ESI
       PUSH    EBX
       PUSH    EDI
       MOV     ESI,ECX
       TEST    EAX,EAX
       JE      @@qt
       MOV     ECX,[EAX-4]
       TEST    ECX,ECX
       JE      @@qt
       MOV     EBX,EAX
       MOV     EDI,EDX
       XOR     EDX,EDX
       MOV     EAX,ESI
       CALL    System.@LStrFromPCharLen
       MOV     EDX,EDI
       MOV     ECX,[EBX-4]
       MOV     EDI,[ESI]
@@lp:   MOV     AL,BYTE PTR [EBX]
       CMP     DL,AL
       JE      @@nx
       MOV     BYTE PTR [EDI],AL
       INC     EDI
@@nx:   INC     EBX
       DEC     ECX
       JNE     @@lp
       MOV     EAX,[ESI]
       MOV     BYTE PTR [EDI],0
       SUB     EDI,EAX
       JE      @@qt
       MOV     [EAX-4],EDI
       POP     EDI
       POP     EBX
       POP     ESI
       RET
@@qt:   MOV     EAX,ESI
       CALL    System.@LStrClr
       POP     EDI
       POP     EBX
       POP     ESI
end;

---

Amoeba   (2006-05-23 10:53:00) [4]

функция Q_DelChar из библиотеки QStrings, она на asm'е.

---

Gydvin   (2006-05-22 23:10:00) [5]

> Не сомневаюсь, что можно сделать еще быстрее :)

аха на ASMe   )))

---

Loginov Dmitry   (2006-05-22 22:56:00) [6]

А теперь, все ответившие, посмотрите хит-парад результатов...

function AlexMSDeleteSpaces(S: String): String;
var
 n: integer;
begin
 Result := '';
 for n := 1 to length(s) do
 if s[n] <> ' ' then Result := Result + s[n];
end;

function JBDeleteSpaces(S: String): String;
var
 p: Integer;
begin
 result := S; // сорри :)

 p:=Pos(' ',result);
 while p>0 do
 begin
   Delete(result,p,1);
   p:=Pos(' ',result);
 end;
end;

function TUserDelSpaces(S: String): String;
var
 i, j: Integer;
begin
 j := 0;
 for i := 1 to length (S) do
   if S[i] = ' ' then
     inc (j);
 SetLength (Result, length(S) - j);
 j := 1;
 for i := 1 to length (S) do
   if S[i] <> ' ' then begin
     Result[j] := S[i];
     inc (j);
   end;
end;

function DeleteSpaces(S: String): String;
var
 I, Counter: Integer;
begin
 SetLength(Result, Length(S));
 Counter := 0;
 for I := 1 to Length(S) do
   if S[I] <> ' ' then
   begin
     Inc(Counter);
     Result[Counter] := S[I];
   end;
 SetLength(Result, Counter);
end;

function GenerateLongString(Size: Integer): String;
var
 I: Integer;
begin
 SetLength(Result, Size);
 for I := 1 to Size do
   if Odd(I) then Result[I] := 'a' else Result[I] := ' ';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 S, S1: String;
 Tc: Cardinal;
begin
 S := GenerateLongString(50000000); // Маленькая строка, всего-то 50 метров :)
 Tc := GetTickCount;
 // S1 := StringReplace(S, ' ', '', [rfReplaceAll]); // более 2х минут (терпения не хватило :)
 // S1 := AlexMSDeleteSpaces(S);  // 14800 мс
 // S1 := JBDeleteSpaces(S);  // более 2х минут (терпения не хватило :)
 // S1 := TUserDelSpaces(S); // 891 мс
 S1 := DeleteSpaces(S);  // 563 мс (выишгыш в 1.58 раз :)
 ShowMessage(IntToStr(GetTickCount - Tc));
end;

Не сомневаюсь, что можно сделать еще быстрее :)

---

Loginov Dmitry   (2006-05-22 21:49:00) [7]

Счас придумаю...

function DeleteSpaces(S: String): String;
var
 I, Counter: Integer;
begin
 SetLength(Result, Length(S));
 Counter := 0;
 for I := 1 to Length(S) do
   if S[I] <> ' ' then
   begin
     Inc(Counter);
     Result[Counter] := S[I];
   end;
 SetLength(Result, Counter);
end;

Имхо, это побыстрее будет.

---

TUser   (2006-05-22 21:36:00) [8]

j := 0;
for i := 1 to length (S) do
 if S[i] = ' ' then
   inc (j);
SetLength (NewS, length(S) - j);
j := 1;
for i := 1 to length (S) do
 if S[i] <> ' ' then begin
   NewS[j] := S[i];
   inc (j);
   end;

Имхо, трудно придумать что-то быстрее.

---

Gydvin   (2006-05-22 21:33:00) [9]

> Loginov Dmitry ©   (22.05.06 20:52) [3]
>
> AlexanderMS ©   (22.05.06 20:13) [2]
>
> Не самый быстрый способ...


А какой быстрее, поделитесь пожалуста

---

Virgo_Style   (2006-05-22 21:29:00) [10]

мои 5 копеек - это аналог [2], только память выделить сразу же SetLength, а потом им же обрезать до нужной длины.

---

jb   (2006-05-22 21:06:00) [11]


p:=Pos(' ',s);
while p>0 do
begin
 Delete(s,p,1);
 p:=Pos(' ',s);
end;


---

Loginov Dmitry   (2006-05-22 21:00:00) [12]

... как и StringReplace :)

---

Loginov Dmitry   (2006-05-22 20:52:00) [13]

AlexanderMS ©   (22.05.06 20:13) [2]

Не самый быстрый способ...

---

Vlad   (2006-05-22 20:13:00) [14]

StringReplace

---

AlexanderMS   (2006-05-22 20:13:00) [15]

var
 g : string;

.......
for n := 1 to length(s) do
if s[n] <> ' ' then g := g + s[n];

s := g;

s - нужная строка

---

Наверх