| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Заменя пробелов [D6, Win2k]
Adam © (2003-01-27 18:13:00)Сдраствуйте мастера!
У меня следующяя проблема:
Имеется строка, в которой слова разделяются проделами. Количество пробелов между двумя словами неизвестно, оно может быть разным. Требуется это количество пробелов заменить всего одним пробелом.. Как это сделать? Помогите, пожалуйста..
Sha (2003-02-01 15:50:00) [1]Топ-лист на 15:00 01.02.2003.
В тесте участвовали программы, возврашающие за приемлемое время правильный результат. Результат считался правильным если из строки были удалены все пробелы, или все пробелы, кроме последнего, или все пробелы и все символы меньшие пробела (соответствующие настройки были сделаны в процедурах InitTBL и Sha).
Все программы были разбиты на 3 категории:
- функции, возращающие String значение,
- процедуры, изменяющие на месте String значение,
- процедуры, изменяющие на месте PChar значение.
Разделение Asm/PurePascal не проводилось.
Для оценки скорости работы программ использовался тест, предложенный Mystic © (29.01.03 21:24) с небольшими изменениями.
Чтобы получить наиболее достоверные результаты тест прогонялся 10 раз по исходным текстам Delphi6 и выбирался наилучший результат. Время выполнения измерялось в тиках процессора. Использовался процессор AMD K6-2+ 500 MHz.
Результаты:
//String func
//St:=Sha4(St); // 227 +
//St:=Q_SpaceCompress(St); // 239 +
//St:=Sha3(St); // 261
//St:=Danilka(St); // 354 -
//St:=Sha(St); // 358
//St:=Romkin(St); // 542 -
//String proc
//Sha4Var(St); // 137 +
//Q_SpaceCompressInplace(St); // 147 +
//Mystic(St); // 278 +
//Pchar proc
//Sha4Inplace(PChar(St)); // 134 +
//SecteyAsm(PChar(St)); // 163 -
//Sha3Inplace(PChar(St)); // 165
//Sectey(PChar(St)); // 191 -
//Digitman(PChar(St)); // 272
Примечания.
1. цифры справа - время в миллионах тиков CPU,
2. + означает, что удаляются все символы, меньшие или равные пробелу,
3. - означает, что последний пробел не удаляется,
Как видно из результатов теста, используя Pascal, можно писать весьма эффективные небольшие программы.
Sha (2003-02-01 15:45:00) [2]Паскальные процедуры/функции для удаления пробелов и управляющих символов, работающие почти также эффективно, как Q_String:
function Sha4(const s: string): string;
var
p, q: pchar;
ch: char;
label
rt;
begin;
p:=pointer(s);
if p<>nil then begin;
SetLength(Result,Length(s));
q:=pchar(pointer(Result))-1;
repeat;
repeat;
ch:=p^;
inc(p);
if ch=#0 then goto rt;
until ch>" ";
inc(q);
repeat;
q^:=ch;
ch:=p^;
inc(q);
inc(p);
until ch<=" ";
q^:=" ";
until ch=#0;
rt: SetLength(Result,(q-pointer(Result))); //SetLength(,-1)=SetLength(,0)
end
else Result:="";
end;
procedure Sha4Var(var s: string);
var
p, q: pchar;
ch: char;
label
rt;
begin;
UniqueString(s);
p:=pointer(s);
if p<>nil then begin;
q:=p-1;
repeat;
repeat;
ch:=p^;
inc(p);
if ch=#0 then goto rt;
until ch>" ";
inc(q);
repeat;
q^:=ch;
ch:=p^;
inc(q);
inc(p);
until ch<=" ";
q^:=" ";
until ch=#0;
rt: SetLength(s,(q-pointer(s))); //SetLength(,-1)=SetLength(,0)
end;
end;
function Sha4Inplace(p: pchar): pchar;
var
q: pchar;
ch: char;
label
rt;
begin;
Result:=p;
if (p<>nil) and (p^<>#0) then begin;
q:=p-1;
repeat;
repeat;
ch:=p^;
inc(p);
if ch=#0 then goto rt;
until ch>" ";
inc(q);
repeat;
q^:=ch;
ch:=p^;
inc(q);
inc(p);
until ch<=" ";
q^:=" ";
until ch=#0;
rt: if q<Result then inc(q);
q^:=#0;
end;
end;
Sha (2003-01-31 15:31:00) [3]2 Secety (30.01.03 02:45)
Кажется, будут проблемы с пустыми строками и последним пробелом.
Sha (2003-01-31 12:52:00) [4]Решил поучаствовать и в конкурсе Inplace-функций:
function Sha3Inplace(p: pchar): pchar;
var
q: pchar;
ch: char;
label
rt;
begin;
Result:=p;
if (p<>nil) and (p^<>#0) then begin;
q:=p-1;
while true do begin;
repeat;
ch:=p^;
inc(p);
until ch<>" ";
if ch=#0 then goto rt;
inc(q);
repeat;
q^:=ch;
ch:=p^;
inc(q);
if ch=#0 then goto rt;
inc(p);
until ch=" ";
q^:=ch;
end;
rt: if q<Result then inc(q);
q^:=ch;
end;
end;
Danilka (2003-01-31 08:11:00) [5]Mystic © (30.01.03 15:30)
вроде все ошибки выправил:
function Danilka(const s:string):string;
var
s2:string;
begin
result:=s;
if s<>"" then begin
UniqueString(result);
asm
lea ebx,s
mov eax,edx
mov ecx,[edx-4]
push edx
@@loop:
mov bx,[edx]
cmp bx,$2020
je @@space
mov [eax],bl
inc eax
@@space:
inc edx
dec ecx
jne @@loop
mov [eax],cl
sub eax,edx
pop edx
add eax,[edx-4]
mov [edx-4],eax
end;
end;
end;
Sha (2003-01-31 08:01:00) [6]> BlackKing (31.01.03 01:26)
> По первому тэсту Sectey © (29.01.03 09:27) выдаёт результат: 950-1050
Как именно выглядел тест? :)
Song (2003-01-31 06:27:00) [7]Ого... вы тему раскатали :-)))))
Ну что ж у меня тоже почётное первое место, правда с конца :)
BlackKing (2003-01-31 01:26:00) [8]Ну ладно, и я решил побаловаться :)
Вот мой вариант этого безобразия.
var
Ii,Nn:DWord;
SSize:DWord;
Procedure DelSpace(S:String);
Begin
SSize:=Length(S);
Ii:=1;
Nn:=1;
While Ii<SSize do
Begin
S[Nn]:=S[Ii];
If S[Ii]=#32 then
While S[Ii]=#32 do
Inc(Ii);
Inc(Ii);
Inc(Nn);
End;
S[Nn]:=#0;
End;
По первому тэсту Sectey © (29.01.03 09:27) выдаёт результат: 950-1050
Danilka (2003-01-30 16:53:00) [9]Mystic © (30.01.03 15:30)
:((
дома вечером посмотрю.
не особо силен я в асме, но ежели что быстрое надо сделать, то imho, только на нем.
Mystic (2003-01-30 15:30:00) [10]> danilka (30.01.03 08:10)
Идея оригинальная!
Но:
procedure TForm1.Button3Click(Sender: TObject);
var
St, St0: string;
begin
St := "1 2";
St0 := Danilka(St);
ShowMessage(IntToStr(Length(St0)));
Edit1.Text := St0;
end;
У меня выводит сообщение с текстом "2", а в Edit1.Text выводится
"1 2 2"?
Кроме того, при выполнении команды Result := s не происходит выделение памяти для новой строки, поэтому ты просто будешь изменять в том числе и исходную строку:
St1 := "1 2";
St2 := "3 4";
St := St1 + St2;
St0 := Danilka(St);
ShowMessage(St);
Выдаст "1 23 4", хотя строка St изменятся не должна.
- (2003-01-30 13:33:00) [11]slon
_jek (2003-01-30 12:52:00) [12]До кучи. У меня работает давно, но наверно не шедевр
function TForm1.Trim_space(s: string):string;
var
i: integer;
n: integer;
begin
n := 0;
Result := "";
if Trim(s) <> "" then
begin
for i := 1 to length(s) do
begin
if copy(s, i, 1) = " " then
begin
n := n + 1;
end
else begin
n := 0;
end;
if n < 2 then
begin
Result := Result + copy(s, i, 1);
end;
end;
end;
end;
Sha (2003-01-30 11:47:00) [13]Думаю, этот вариант не опустится ниже третьего места, пропустив вперед только asm:
function Sha3(const s: string): string;
var
p, q: pchar;
ch: char;
label
rt;
begin;
p:=pointer(s);
if p<>nil then begin;
SetLength(Result,Length(s));
q:=pchar(pointer(Result))-1;
while true do begin;
repeat;
ch:=p^;
inc(p);
until ch<>" ";
if ch=#0 then goto rt;
inc(q);
repeat;
q^:=ch;
ch:=p^;
inc(q);
if ch=#0 then goto rt;
inc(p);
until ch=" ";
q^:=ch;
end;
rt: SetLength(Result,(q-pointer(Result))); //SetLength(,-1)=SetLength(,0)
end
else Result:="";
end;
REA (2003-01-30 11:10:00) [14]Вашу бы энергию да в мирных целях...
Worker (2003-01-30 11:09:00) [15]> Adam
Попробуй так, у меня все работает:
function TForm1.DeleteProbel(s: string): string;
var
str_new: string;
begin
Result := Trim(s);
While Pos(" ",Result) <> 0 do begin
str_new := str_new +" "+ copy(Result,0,Pos(" ",Result)-1);
Delete(Result,1,Pos(" ",Result)-1);
Result := Trim(Result);
end;
Result := str_new +" " + Result;
end;
danilka (2003-01-30 10:19:00) [16]Anatoly Podgoretsky © (30.01.03 09:40)
Учту. Только для такой битвы может и правда, сначала более точно поставить задачу, например убивать или нет пробелы в начале/конце строки, если да, то работать ли с многострочным текстом, работать со string или pchar и т.д. Разобраться с методикой тестирования, выложить алгоритм тестирования и в бой. :))
а еще, может более правильным было-бы чтобы другие участники не видели чужой код до окончания тестирования. например, чтобы все слали свои процедуры кому-нибудь на почту, скажем, до 12-00 пятницы, потом этот кто-то все-бы протестировал, и выложил в форум результат всемте с алгоритмами.
Novice (2003-01-30 10:11:00) [17]> gsu © (29.01.03 23:39)
> красавцы (-:|~
По этой ветке сразу видно, что не перевелись у нас те, кто любит попрограммировать. Тех, у кого на это нет времени, просьба не беспокоиться.
> All
Привет участникам соревнований! © "Ну, погоди!"
Предлагаю по аналогии со значком © завести значек (R), который присваивается всем призерам соревнований. Соревнование считать состоявшимся, при условии, что в нем участвовал хотя бы один мастер. Цветовую гамму можно изменить.
Anatoly Podgoretsky (2003-01-30 09:40:00) [18]danilka (30.01.03 08:10)
Если ты хочешь по быстрее, то надо убрать push ecx (мелочи) и заменить loop @@loop (это уже серьезный тормоз) простыми инструкциями.
Separator (2003-01-30 09:37:00) [19]В общем народ, вопрос конечно очень интересный, но не пора ли закончить?
Digitman (2003-01-30 08:55:00) [20]
> Sectey © (29.01.03 18:18)
> ну коль перешли на inplace
Да никто никуда не переходил !)
Просто я предложил собственный, давно уже сверстанный и работающий в IB UDF вариант. Без in-place в том случае было трудно обойтись, ибо реаллокация памяти по соглашениям IB дает даже большие "тормоза", нежели с использованием менеджера памяти от Борланда. И он меня вполне устраивал все это время, даже в первозданном, неоптимизированном виде, поскольку без сколь-либо заметной задержки "причесывает" строку перед записью в базу. При этом включая и LTrim и RTrim.
Так что меряться в производительности алгоритма я и не думал - мне и этого достаточно. А при желании, конечно, оптимизировать его можно в 10 минут, доведя производительность до "вылизанного" с точностью до маш.инструкции asm-уровня и сохранив при этом исх.текст в синтаксисе Паскаля)
| |
Страницы: 