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

← →
Sha (2003-01-30 07:15) [80]

> Secety (30.01.03 02:45)
> Ну согласись сравнивать программы написанную на асме и на делфях скажем не совсе чесно.

Важнее даже другое: все программы (или их обертка в цикле тестирования) должны брать const string и возвращать string - иначе вообще невозможно говорить ни о каком сравнении результатов.

А насчет asm - мне даже интересно на сколько процентов будет эффективнее. Думаю, что для моей Sha2 - не больше чем на 10. (Правда она пока еще работает неправильно, зато уже быстро :)
А это как раз и докажет, что не так важно, на чем писать.

← →
Anatoly Podgoretsky (2003-01-30 08:04) [81]

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

Немаловажное значение имеет выравнивание переменных
и будет давать разные результаты на разных процессорах.
Для теста надо что бы данные были выровнены на границу параграфа.
В группе borland.basm знаимались аналогичным тестированием, но только для Move и там потом пришлось потратить около недели на выработку достоверного теста, в основном для выравнивания на границу параграфа и частично других вещей.

Неправильно или специально подогнанный тест может отдавать предпочтение тому или другому методу.

← →
danilka (2003-01-30 08:10) [82]

ловите вариант на асме.
всера дома накатал.

function Danilka(const s:string):string;
begin
result:=s;
asm
push ebx
push ecx
mov ebx,result
mov edx,[ebx]
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
loop @@loop
sub eax,edx
pop edx
add eax,[edx-4]
dec eax
mov [edx-4],eax
pop ecx
pop ebx
end;
end;

← →
Digitman (2003-01-30 08:55) [83]

> Sectey © (29.01.03 18:18)

> ну коль перешли на inplace

Да никто никуда не переходил !)
Просто я предложил собственный, давно уже сверстанный и работающий в IB UDF вариант. Без in-place в том случае было трудно обойтись, ибо реаллокация памяти по соглашениям IB дает даже большие "тормоза", нежели с использованием менеджера памяти от Борланда. И он меня вполне устраивал все это время, даже в первозданном, неоптимизированном виде, поскольку без сколь-либо заметной задержки "причесывает" строку перед записью в базу. При этом включая и LTrim и RTrim.
Так что меряться в производительности алгоритма я и не думал - мне и этого достаточно. А при желании, конечно, оптимизировать его можно в 10 минут, доведя производительность до "вылизанного" с точностью до маш.инструкции asm-уровня и сохранив при этом исх.текст в синтаксисе Паскаля)

← →
Separator (2003-01-30 09:37) [84]

В общем народ, вопрос конечно очень интересный, но не пора ли закончить?

← →
Anatoly Podgoretsky (2003-01-30 09:40) [85]

danilka (30.01.03 08:10)
Если ты хочешь по быстрее, то надо убрать push ecx (мелочи) и заменить loop @@loop (это уже серьезный тормоз) простыми инструкциями.

← →
Novice (2003-01-30 10:11) [86]

> gsu © (29.01.03 23:39)
> красавцы (-:|~

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

> All

Привет участникам соревнований! © "Ну, погоди!"
Предлагаю по аналогии со значком © завести значек (R), который присваивается всем призерам соревнований. Соревнование считать состоявшимся, при условии, что в нем участвовал хотя бы один мастер. Цветовую гамму можно изменить.

← →
danilka (2003-01-30 10:19) [87]

Anatoly Podgoretsky © (30.01.03 09:40)
Учту. Только для такой битвы может и правда, сначала более точно поставить задачу, например убивать или нет пробелы в начале/конце строки, если да, то работать ли с многострочным текстом, работать со string или pchar и т.д. Разобраться с методикой тестирования, выложить алгоритм тестирования и в бой. :))

а еще, может более правильным было-бы чтобы другие участники не видели чужой код до окончания тестирования. например, чтобы все слали свои процедуры кому-нибудь на почту, скажем, до 12-00 пятницы, потом этот кто-то все-бы протестировал, и выложил в форум результат всемте с алгоритмами.

← →
Worker (2003-01-30 11:09) [88]

> 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;

← →
REA (2003-01-30 11:10) [89]

Вашу бы энергию да в мирных целях...

← →
Sha (2003-01-30 11:47) [90]

Думаю, этот вариант не опустится ниже третьего места, пропустив вперед только 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;

← →
_jek (2003-01-30 12:52) [91]

До кучи. У меня работает давно, но наверно не шедевр

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;

← →
- (2003-01-30 13:33) [92]

slon

← →
Mystic (2003-01-30 15:30) [93]

> 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 изменятся не должна.

← →
Danilka (2003-01-30 16:53) [94]

Mystic © (30.01.03 15:30)
:((
дома вечером посмотрю.
не особо силен я в асме, но ежели что быстрое надо сделать, то imho, только на нем.

← →
BlackKing (2003-01-31 01:26) [95]

Ну ладно, и я решил побаловаться :)
Вот мой вариант этого безобразия.

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

← →
Song (2003-01-31 06:27) [96]

Ого... вы тему раскатали :-)))))
Ну что ж у меня тоже почётное первое место, правда с конца :)

← →
Sha (2003-01-31 08:01) [97]

> BlackKing (31.01.03 01:26)
> По первому тэсту Sectey © (29.01.03 09:27) выдаёт результат: 950-1050

Как именно выглядел тест? :)

← →
Danilka (2003-01-31 08:11) [98]

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 12:52) [99]

Решил поучаствовать и в конкурсе 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;

← →
Sha (2003-01-31 15:31) [100]

2 Secety (30.01.03 02:45)
Кажется, будут проблемы с пустыми строками и последним пробелом.

← →
Sha (2003-02-01 15:45) [101]

Паскальные процедуры/функции для удаления пробелов и управляющих символов, работающие почти также эффективно, как 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-02-01 15:50) [102]

Топ-лист на 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, можно писать весьма эффективные небольшие программы.

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