Заменя пробелов

← →
Adam (2003-01-27 18:13) [0]

Сдраствуйте мастера!

У меня следующяя проблема:

Имеется строка, в которой слова разделяются проделами. Количество пробелов между двумя словами неизвестно, оно может быть разным. Требуется это количество пробелов заменить всего одним пробелом.. Как это сделать? Помогите, пожалуйста..

← →
Victor_Cr (2003-01-27 18:17) [1]

пока существует хотя бы одна последовательность с двумя пробелами заменяй найденые два на один...

← →
Chubais (2003-01-27 19:17) [2]

> Сдраствуйте

гыыы

← →
Song (2003-01-27 21:07) [3]

S:=StringReplace(S,#32#32,#32,[rfReplaceAll]);
вот так попробуй, мне даже самому интересно, пройдёт или нет.

← →
MAN-In-RED (2003-01-27 21:14) [4]

> Song © (27.01.03 21:07)

Оно та пройдет, только если строго два пробела между словами, а автор ветки говорит, что количество пробелов между двумя словами неизвестно, вот так ;)

← →
Antosya (2003-01-27 21:39) [5]

Вот полностью работоющий код, !
var a,d:string[100]; b,c:integer; begin a:=Edit1.Text; //предположим, это твоя строка d:=" "; b:=pos(d,a); if b<>0 then begin repeat b:=pos(d,a); if b<>0 then delete(a,b,1); until b=0; Edit1.Text:=a;//а вот и строка где только по одному пробелу! end else Edit1.Text:=a;//это если везде по одному пробелу!

← →
MAN-In-RED (2003-01-27 21:44) [6]

Вот мой вариант:
procedure TForm1.Button1Click(Sender: TObject); var Str, S :String; I :Integer; Spc :Boolean; begin Str := "Q W ER T Y U "; for I:=1 to Length(Str) do if Str[i]=#32 then begin if not Spct then begin S := S+" "; Spc := True; end; end else begin S := S+Str[i]; Spc := False; end; ShowMessage(""""+S+""""); end;

← →
MAN-In-RED (2003-01-27 21:50) [7]

Мой быстрее :)

← →
Romkin (2003-01-27 22:36) [8]

Кину и я камень...
function OneSpace(const s: string): string; var newLength, i, k: integer; lastChar: char begin Result := ""; newLength := length(s); if newLength = 0 then exit; SetLength(Result, newLength); lastchar := #0; k := 0; for i := 1 to length(s) do if not ((LastChar = #32) and (s[i] = #32)) then begin inc(k); Result[k] := s[i]; LastChar := s[i]; end; SetLength(Result, k); end;
Без отладки, но, думаю, идея должна быть ясна %-)) - переписываем только одинарные пробелы. Здесь еще страховка насчет нулевой длины и только одного символа в строке... Что в голову пришло, но работать должно быстро

← →
Separator (2003-01-28 08:30) [9]

var i: integer; begin i:= Pos(#32#32, Edit1.Text); while i <> 0 do begin Delete(Edit1.Text, i, 1) i:= Pos(#32#32, Edit1.Text); end end
Правда работать будет долго

← →
Юрий Зотов (2003-01-28 10:04) [10]

function Song(S: string): string;
begin
Result := S;
while Pos(" ", Result) > 0 do // Без цикла не проходит.
Result := StringReplace(Result, " ", " ", [rfReplaceAll])
end;

function Antosya(S: string): string;
var
d: string[100];
b: integer;
begin
Result := S;
d := " ";
b := pos(d, Result);
if b <> 0 then
repeat
b := pos(d, Result);
if b <> 0 then delete(Result, b, 1);
until b = 0
end;

// function ManInRed(const s: string): string;
// Sorry, не дает правильного результата

function Romkin(const s: string): string;
var
NewLength, i, k: integer;
LastChar: char;
begin
Result := "";
NewLength := Length(s);
SetLength(Result, NewLength);
lastchar := #0;
k := 0;
for i := 1 to Length(s) do
if not ((LastChar = #32) and (s[i] = #32)) then
begin
Inc(k);
Result[k] := S[i];
LastChar := S[i]
end;
SetLength(Result, k)
end;

function Separator(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;

procedure TForm1.Button1Click(Sender: TObject);
const
Src = "Q W ER T Y U ";
var
Tick: DWORD;
i: integer;
S: string;
begin
Tick := GetTickCount;
for i := 1 to 10000 do
// S := Song(Src); // 1523, 1521, 1523
// S := Antosya(Src); // 423, 426, 424
// S := Romkin(Src); // 22, 25, 24
S := Separator(Src); // 215, 213, 214
Tick := GetTickCount - Tick;
Caption := Format("%s : %u", [S, Tick])
end;

← →
kkostik (2003-01-28 10:06) [11]

function StrDelSimv(PrStr : String; Simv : String) : String;
var i : Integer;
begin
i:=1;
While Length(PrStr)>=i Do
if PrStr[i]=Simv then
Delete(PrStr, i, 1)
else i:=i+1;
Result:=PrStr;
end;
Удаление любово символа из строки

← →
Separator (2003-01-28 10:56) [12]

Почти тоже, что и у MAN-In-RED © (27.01.03 21:44)
function StrDelSpace(S: string): string; var i: integer; Space: boolean; begin Space:= false; for i:= 1 to Length(S) do if (S[i] = #32) and (not Space) then begin Space:= true; Result:= Result + #32 end else if (S[i] <> #32) then begin Space:= false; Result:= Result + S[i] end end;

← →
REA (2003-01-28 11:27) [13]

Ну нифига себе проблема! Вы еще GREP подключите.

← →
Бук (2003-01-28 13:25) [14]

Ну вы блин даете!
memo1.Text:=AnsiReplaceText(memo1.Text,#32#32,#32);
Сие действо можно повторить в цикле нужное количество раз. Быстро и сердито.

← →
Юрий Зотов (2003-01-28 15:18) [15]

> Бук (28.01.03 13:25)
> Сие действо можно повторить в цикле нужное количество раз.
> Быстро и сердито.

Результаты теста видели? Самый медленный из рассмотренных алгоритмов. Примерно в 70 раз уступает самому быстрому.

Это насчет "быстро". Что же касается "сердито"... а что это такое - "сердитый алгоритм"?

Который пишется в 2 строки? А всегда ли это хороший критерий?

← →
Мефодий (2003-01-28 15:57) [16]

А что если попроще:

function MySpaceEraser(s: string): string;
begin
while Pos(" ",s) > 0 do {в ковычках два пробела}
System.Delete(s,Pos(" ",s),1);
Result := s;
end;

← →
Sha (2003-01-28 16:24) [17]

Тоже хочется поучаствовать:
function Sha(const s: string): string; const DeleteFirstBlank= false; DeleteLastBlank= false; var p: PChar; i, j, len: integer; ch: char; begin; len:=Length(s); SetLength(Result,len); if len>0 then begin; ch:=#0; if DeleteFirstBlank then ch:=" "; p:=pointer(s); j:=pointer(Result)-p; for i:=0 to len-1 do begin; if ch<>(p+i)^ then ch:=(p+i)^ else if ch=" " then continue; (p+j)^:=ch; inc(j); end; SetLength(Result,j-(pointer(Result)-p)-ord((ch=" ") and DeleteLastBlank)); end; end;

← →
MAN-In-RED (2003-01-28 19:45) [18]

> Юрий Зотов © (28.01.03 10:04)

Я в шоке! Что значит не дает правильного результата, все дает, только брать надо уметь…:)
Я проверял, все прекрасно работает!

Вот моя функция:

function OneSpace(Str: String): String; var S :String; I :Integer; Spc :Boolean; begin for I:=1 to Length(Str) do if Str[i]=#32 then begin if not Spc then begin S := S+" "; Spc := True; end; end else begin S := S+Str[i]; Spc := False; end; Result := S; end;
Пример вызова:

ShowMessage(OneSpace("q wer t y u"));

Результат – q wer t y u

Все пробелы были заменены на один!
Что не так?

> Antosya © (27.01.03 21:39)

> Бук (28.01.03 13:25)

> Мефодий (28.01.03 15:57)

Код типа:
ShowMessage(StringReplace("q w e rty u i o ",#32#32,#32,[rfReplaceAll]));

Не даст нужного результата, разве что в цыкле...

Требую перепросмотра моей функции :)

← →
Юрий Зотов (2003-01-29 01:00) [19]

> MAN-In-RED © (28.01.03 19:45)

> Что не так?

Пустячок - первый Ваш вариант просто не компилируется. А после устранения ошибки может сработать верно, а может и нет. Смотря какой первый символ в строке и на какой случайный мусор попадет переменная Spc (кстати, эта же болячка и во втором варианте - у Вас warning"и отключены, или Вы их просто в голову не берете?).

Ну, ладно, я внял Вашему призыву, что брать тоже надо уметь, и код чуть-чуть подчистил (надеюсь, Вы поверите, что я тоже немного умею кодить и не старался специально его ухудшить?)

Вот результат:
- первый Ваш вариант: 225, 226, 229
- второй Ваш вариант: 278, 273, 281

Так что Ваша апелляция возымела успех. Поздравляю с почетным третьим местом.

← →
Юрий Зотов (2003-01-29 01:29) [20]

Ну уж, чтобы и все приславшие код поучаствовали в конкурсе (кроме kkostik, поскольку его функция несколько из другой оперы).

> Separator © (28.01.03 10:56)
Вы правильно сказали - почти то же, что и у MAN-In-RED. Тоже не дает правильного результата (не верите - вызовите в цикле и увидите, что компилятор не всегда делает предварительную чистку строковых переменных). После поправки кода итог такой - 227, 232, 228. Практически то же, что и в первом варианте MAN-In-RED.

> Мефодий (28.01.03 15:57)
Результат - 280, 281, 283. Практически то же, что и во втором варианте MAN-In-RED, но закодировано, как Вы и говорили, в две простые строчки.

> Sha © (28.01.03 16:24)
Результат - 16, 20, 16. Если я правильно понял суть кода, идея Romkin"а дополнена самостоятельной работой с адресами, не полагаясь на компилятор. Итог - налицо.

← →
Один из вариантов (2003-01-29 06:52) [21]

А как насчет вот такого варианта?
function delspace(s:string):string;
var s:string
begin
while pos(" ",s) > 0 do // Delete " "
delete(s,pos(" ",s),1);
result:=s;
end;

← →
Один из вариантов (2003-01-29 06:54) [22]

sorry после того как отправил заметил что уже такой вариант был

← →
Separator (2003-01-29 07:43) [23]

> Юрий Зотов © (29.01.03 01:29)

Укажите мне на ошибку, а то я её что-то не замечаю. Хоть десять раз по циклу запустить, все равно работает правильно. Все пробелы идущие последовательно и имеющие количество большее одного заменяются на один.

← →
Anatoly Podgoretsky (2003-01-29 08:08) [24]

Ну если не понял, что было тебе сказано, то вот упрощенным русским языком

Нет начальное инициализации возвращаемого значения. Надо в начале сделать Result := "";, Space то ты нинциализировал.

← →
Бук (2003-01-29 08:10) [25]

> Юрий Зотов © (28.01.03 15:18)
Если Вы внимательно читали тему, то вопрос был не о скорости выполнения алгоритма, а о том как. И я не ставил перед собой цель написать высокоскоростной алгоритм удаления пробелов. Что касается скорости - все вопросы к Борланду :))

> Что же касается "сердито"... а что это такое - "сердитый алгоритм"?

Не надо придераться к словам....
-----------------------------------
С уважением Бук

← →
Separator (2003-01-29 08:26) [26]

> Anatoly Podgoretsky © (29.01.03 08:08)

Сапасибо за разъяснение, теперь понял

← →
Digitman (2003-01-29 09:10) [27]

in-place-вариант удаления лишних пробелов:

function ReduceSpaces(Src: PChar): PChar; var i,j,c,f: Integer; k: Boolean; begin Result := Src; if Assigned(Result) then begin if Result[0] <> #0 then begin i:= 0; j:= 0; c:= 0; f:= 0; k:= False; while Result[i] <> #0 do begin if Result[i] <> " " then begin if not k then begin k:= True; c:= 0; Inc(f); end; if i > j then Result[j]:= Result[i]; Inc(j); end else begin if k then begin k:= False; if i > j then Result[j]:= Result[i]; Inc(j); end else begin if (f > 0) and (c = 0) then begin if i > j then Result[j]:= Result[i]; Inc(j); end; end; Inc(c); end; Inc(i); end; if c > 0 then Dec(j); Result[j]:= #0; end else Result := nil; end; end;

← →
Digitman (2003-01-29 09:12) [28]

Преимущества : нет перераспределения памяти
Недостатки : не будет работать с read-only-строкой

← →
Sectey (2003-01-29 09:27) [29]

Люди ну возмите библиотеку QStrings и не надо изобретать велосипед. Там есть функции пости на все случаи жизни. Если кого интеремует намыл.

Я тут произвел небольшой тест и вот что получилось.

Q_SpaceCompress - 688
sha - 797
Romkin - 1468
Separator - 13219
Antosya - 20250
OneSpace - 29845
Song - 389937
StrDelSpace - умер

процедура теста:
procedure TForm1.Button1Click(Sender: TObject); var s : string; t : DWORD; i : integer; begin t := GetTickCount; for i:= 0 to 1000000 do begin s := "ssd sd sd s s sds d s d sd sd s sd s "; Separator(s); end; ShowMessage(s + #13#10 + IntToStr(GetTickCount - t)); end;

← →
Юрий Зотов (2003-01-29 09:29) [30]

> Digitman © (29.01.03 09:10)
> in-place-вариант удаления лишних пробелов

И его результат - 14, 14, 13.
На сегодня это рекорд. Кто хочет посостязаться?

← →
Separator (2003-01-29 09:33) [31]

Кто следующий?

← →
Delirium^.Tremens (2003-01-29 09:36) [32]

Заменя пробелов
А за меня - Забоев.
:-)

← →
Sectey (2003-01-29 09:46) [33]

>Юрий Зотов

Q_SpaceCompress - лучше.

ReduceSpaces - 891

исходный код из QStrings v6.06

Q_SpaceCompress удаляет из строки начальные и конечные пробелы и управляющие символы (меньше пробела). Кроме того, все подряд ущие пробелы и управляющие символы в середине строки заменяются одним пробелом. Исходная строка при этом не изменяется. Эта функция работает медленнее, чем Q_SpaceCompressInPlace

function Q_SpaceCompress(const S: string): string;
asm
PUSH ESI
MOV ESI,EDX
TEST EAX,EAX
JE @@qt
MOV ECX,[EAX-4]
TEST ECX,ECX
JE @@qt
PUSH EBX
MOV EBX,EAX
XOR EDX,EDX
MOV EAX,ESI
CALL System.@LStrFromPCharLen
MOV ECX,[EBX-4]
MOV EDX,[ESI]
@@lp1: CMP BYTE PTR [EBX],$20
JA @@ex1
INC EBX
DEC ECX
JNE @@lp1
JMP @@wq
@@ex1: DEC ECX
@@lp2: CMP BYTE PTR [EBX+ECX],$20
JA @@lp3
DEC ECX
JMP @@lp2
@@lp3: MOV AL,BYTE PTR [EBX]
INC EBX
CMP AL,$20
JBE @@me
@@nx: MOV BYTE PTR [EDX],AL
INC EDX
DEC ECX
JNS @@lp3
@@wq: MOV EAX,[ESI]
MOV BYTE PTR [EDX],0
SUB EDX,EAX
MOV [EAX-4],EDX
POP EBX
POP ESI
RET
@@me: MOV BYTE PTR [EDX],$20
INC EDX
DEC ECX
JS @@wq
@@ml: MOV AL,BYTE PTR [EBX]
INC EBX
CMP AL,$20
JA @@nx
DEC ECX
JNS @@ml
JMP @@wq
@@qt: MOV EAX,ESI
CALL System.@LStrClr
POP ESI
end;

← →
Юрий Зотов (2003-01-29 09:57) [34]

Тест Q_SpaceCompress - 9, 10, 13.
Абсолютный рекорд?

← →
MBo (2003-01-29 10:13) [35]

>Абсолютный рекорд?
Ну так и должно быть - QStrings - хорошо отлаженная и оптимизированная библиотека, обогнать ее довольно сложно, обычно только на специальных, а не на общих задачах.
Кстати, один из ее авторов - Сергей Щербаков (Mover) - входит в число авторов этого сайта.

← →
Johnmen (2003-01-29 10:38) [36]

>Юрий Зотов ©

Q_SpaceCompress не может участвовать в соревновании, т.к. соревнуются коды, написанные на D.

Юрий, как учитывалось время на преобразование string<->pchar в варианте Digitman © ?

← →
REA (2003-01-29 10:58) [37]

Может борду открыть "Нет пробелам"? Или "Состязания по переходу с Delphi на Assembler". В принципе можно просто "Загадочки". Победителям давать малиновые штаны.

← →
Юрий Зотов (2003-01-29 14:08) [38]

> Johnmen © (29.01.03 10:38)
> как учитывалось время на преобразование string<->pchar в
> варианте Digitman?

Оно входило в общее время. Вызов был таким:
S := String(Digitman(PChar(Src)));

Хотя это, возможно, и не совсем корректно - к коду функции фактически добавляется еще несколько машинных команд (хотя, думаю, это мизер по сравнению с количеством команд в самой функции).

Как Вы понимаете, я и не ставил задачей сделать хороший тест. Это всего лишь оценка на скорую руку. Но даже такие и оценочные результаты дают неплохой материал для выводов, не так ли?

← →
Johnmen (2003-01-29 14:36) [39]

> Юрий Зотов © (29.01.03 14:08)
> Оно входило в общее время.

А нет ли здесь ошибки ? После первого же вызова Digitman() строка Scr уже не та, что раньше: все слова в Src разделены одним пробелом. Все последующие итерации цикла просто ничего не делают.

← →
Digitman (2003-01-29 14:51) [40]

> Johnmen

Чего то я тебя не понял)

> После первого же вызова .. строка Srс уже не та,
> что раньше: все слова в Src разделены одним пробелом.

Разумеется ! На то и in-place-алгоритм...
Убирает лишние (ведущие/терминирующие/межсловные) пробелы в указанном блоке памяти со строковыми данными, терминированными #0

> Все последующие итерации цикла просто ничего не делают.

Какие итерации-то ? Вызов уже сделан, Result указывает на тот же блок данных (либо nil, если Src-строка пуста)

Заменя пробелов Найти похожие ветки