Текущий архив: 2004.01.16;
Скачать: CL | DM;
Вниз
Функция разбивающая строку по разделителям... Найти похожие ветки
← →
Knight © (2003-12-22 16:16) [0]... и загоняющая результат в массив. Упростите, кто-нибудь это... желательно без TStrArr...
>> Sha © (22.12.03 15:18) [41]
> Сколько параметров у Explode?
Можно добавить символ разделителя (у меня он передаётся, как первый символ разбиваемой строки). Остальное не важно, лишь бы работало и без дополнительных типов.
type TStrArr=Array of String;
function Explode(Str:String):TStrArr;
var i,k,Len:Integer;
begin
Result:=nil;
Len:=Length(Str);
if Len>0 then begin
k:=1;
for i:=2 to Len+1 do begin
if (i=Len+1) or (Str[i]=Str[1]) then begin
SetLength(Result,Length(Result)+1);
Result[High(Result)]:=Copy(Str,k+1,i-k-1);
k:=i;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var A:TStrArr;
i:Integer;
begin
Memo1.Clear;
A:=Explode(false," Имеется переменная String как ее разбить на символы?");
for i:=0 to Length(A)-1 do Memo1.Lines.Append(A[i]);
A:=nil;
end;
← →
Ega23 © (2003-12-22 16:18) [1]
Function DelimitedStrToList(sIn:string; Strs:Tstrings;delims:TCharSet):integer;
var i:integer;
s0,s1:string;
ch:char;
begin
if sIn="" then Exit;
strs.Clear;
s0:=sIn;
for i:=0 to 255 do //repl ;; =>; ;
begin
ch:=chr(i);
if ch in Delims then s0:=ReplaceStr(S0,ch+ch, ch+" "+ch);
end;
i:=1;
while true do
begin
s1:=ExtractWord(i,s0,delims);
if s1="" then break;
strs.add(s1);
inc(i);
end;
result:=strs.Count;
end;
Но это с использованием Rx-овскогоStrUtils
← →
Rouse_ © (2003-12-22 16:21) [2]
procedure TForm1.Button1Click(Sender: TObject);
var
S: String;
begin
S := "1#2#3#4";
Memo1.Text := StringReplace(S, "#", #13#10, [rfReplaceAll]);
end;
Так пойдет ;)
← →
Sha © (2003-12-22 16:26) [3]
// Sha_UnchainFirstWord отделяет первое слово от строки.
// Выделенное слово не содержит разделителей. Оставшаяся после отделения
// часть строки в месте раздела не содержит разделителей.
function Sha_UnchainFirstWord(Delimiter: char; var Tail: string): string;
var
i, len1, len2: integer;
p: pchar;
begin;
UniqueString(Tail);
p:=pointer(Tail);
i:=0; len1:=Length(Tail); len2:=0;
if i<len1 then repeat;
if p[i]<>Delimiter then inc(len2) else if len2>0 then break;
inc(i);
until i>=len1;
if len2>0 then begin;
SetString(Result,pchar(@p[i-len2]),len2);
while (i<len1) and (p[i]=Delimiter) do inc(i);
len1:=len1-i;
if len1=0 then Tail:="" else begin;
System.Move(p[i],p[0],len1+1);
(pinteger(p-4))^:=len1;
end;
end
else begin;
Tail:=""; Result:="";
end;
end;
// Sha_UnchainLastWord отделяет последнее слово от строки.
// Выделенное слово не содержит разделителей. Оставшаяся после отделения
// часть строки в месте раздела не содержит разделителей.
function Sha_UnchainLastWord(Delimiter: char; var Head: string): string;
var
i, len: integer;
p: pchar;
begin;
UniqueString(Head);
p:=pointer(Head);
i:=Length(Head)-1; len:=0;
if i>=0 then repeat;
if p[i]<>Delimiter then inc(len) else if len>0 then break;
dec(i);
until i<0;
if len>0 then begin;
SetString(Result,pchar(@p[i+1]),len);
while (i>=0) and (p[i]=Delimiter) do dec(i);
if i<0 then Head:=""
else begin;
p[i+1]:=#0;
(pinteger(p-4))^:=i+1;
end;
end
else begin;
Head:=""; Result:="";
end;
end;
← →
Knight © (2003-12-22 16:37) [4]>> Ega23 © (22.12.03 16:18) [1]
У меня и то на оди проход, а тут сперва подготовка строки для другой функции, которая использует другую функцию... вобщем через ж..у как-то :)
>> Rouse_ © (22.12.03 16:21) [2]
:)
Вторая часть это демонстрация, что она работает... на самом деле массив используется иначе.
>> Sha © (22.12.03 16:26) [3]
Если я правильно понял, то это что-то другое... :)
← →
ИдиотЪ © (2003-12-22 16:40) [5]так надо в один проход или нормально все-таки сделать ?
пихать все в одну процедуру - будущего не светит
← →
Ega23 © (2003-12-22 16:41) [6]
> Knight © (22.12.03 16:37) [4]
Тебе чего надо-то? Функция готовая или ты изысками теоретическими занимаешься для совершенствования алгоритма?
← →
Sha © (2003-12-22 16:43) [7]> Knight © (22.12.03 16:37) [4]
> Если я правильно понял, то это что-то другое... :)
А дальше сам :)
← →
Sha © (2003-12-22 16:49) [8]Вот тебе за один проход:
// Sha_WordsToRightMarkedText собирает текст из слов, вставляя между ними
// символ Mark. В конец собранной строки всегда добавляется Mark.
// Специальной обработки кавычек не производится.
// Символы Mark, встреченные в словах, заменяются символами NotMark.
// Если Compress=true, то выполняется сжатие пробелов и управляющих символов в словах.
function Sha_WordsToRightMarkedText(Words: TStrings;
Mark: char= #127; NotMark: char= #32; Compress: boolean= true): string;
var
MarkString: string;
start, stop: pchar;
i: integer;
wd: string;
ch: char;
before, after: boolean;
begin;
MarkString:=Mark;
Result:="";
before:=Compress and (Mark=#32);
after:=Compress and (not before);
with Words do for i:=0 to Count-1 do begin;
wd:=Strings[i];
if before then Sha_SpaceCompressInplace(wd);
start:=pointer(wd);
if start<>nil then begin;
stop:=start + Length(wd);
while true do begin;
ch:=start^;
inc(start);
if (ch>=#32) and (ch<>Mark) then continue;
if start>stop then break;
(start-1)^:=NotMark;
end;
end;
if after then Sha_SpaceCompressInplace(wd);
Result:=Result + wd + MarkString;
end;
end;
// Sha_RightMarkedTextToWords разбивает текст на слова.
// Разделителями слов считаются все управляющие символы (меньшие пробела)
// и Mark. Пробел не является разделителем слов, если только Mark<>#32.
// Специальной обработки кавычек не производится.
// Предварительная очистка списка слов не выполняется.
// Слова длиной меньше MinLength в список слов не включаются.
// Если Compress=true, то выполняется сжатие пробелов и управляющих символов в словах.
procedure Sha_RightMarkedTextToWords(const RightMarkedText: string; Words: TStrings;
Mark: char= #127; MinLength: integer= 0; Compress: boolean= true);
var
start, stop: pchar;
len: integer;
wd: string;
ch: char;
begin;
stop:=pointer(RightMarkedText);
if stop<>nil then repeat;
start:=stop;
repeat;
ch:=stop^;
inc(stop);
until (ch<#32) or (ch=Mark);
len:=stop-start-1;
if (ord(ch) or len<>0) and (len>=MinLength) then begin;
SetString(wd,start,len);
if Compress then Sha_SpaceCompressInplace(wd);
Words.Add(wd);
end;
until ch=#0;
end;
← →
Knight © (2003-12-22 16:49) [9]Сам я в сабже... треба упростить или хотя бы совет, как избавиться от дополнительно типа...
← →
Knight © (2003-12-22 16:52) [10]Странное у вас упрощение... в сабже функция на 17 строк (вместе с объявлением нового типа... :)
← →
ИдиотЪ © (2003-12-22 16:54) [11]вот я помню в турбо-паскале на 286 хт, ну там еще имело смысл чего-то мудрить, но сейчас от ваших измышлений винда быстрее не заработает
← →
Sha © (2003-12-22 16:55) [12]> Knight © (22.12.03 16:49) [9]
Советов больше, чем достаточно :)
Форум больше похож на стартер, чем на мотор.
Тебя толкнули, дальше крутись сам.
Если мотор постоянно глохнет, работа стартера бесполезна.
← →
ИдиотЪ © (2003-12-22 16:56) [13]Sha ©
))
вай, харашо сказал, а
← →
Sha © (2003-12-22 16:58) [14]> Knight © (22.12.03 16:52) [10]
> Странное у вас упрощение... в сабже функция на 17 строк
Так все-таки, сколько параметров у Explode?
← →
Rouse_ © (2003-12-22 17:12) [15]> [12] Sha © (22.12.03 16:55)
Мощно задвинул... ;))
← →
Knight © (2003-12-22 17:21) [16]>> Sha © (22.12.03 16:58) [14]
Символ разделителя, можно отдельно, можно как у меня.
Строка, которую надо разбить.
Вывод результата, можно как var процедуры, можно как Result функции.
Пробовал через указатели, но что-то не получается...
← →
Sha © (2003-12-22 17:26) [17]> Knight © (22.12.03 17:21) [16]
а почему вызываешь так:
A:=Explode(false," Имеется переменная String как ее разбить на символы?");
← →
Ega23 © (2003-12-22 17:26) [18]
> Knight © (22.12.03 17:21) [16]
Ты чего хочешь? Минимальную по коду или полнофункциональную функцию?
← →
Sha © (2003-12-22 17:28) [19]> Ega23 © (22.12.03 17:26) [18]
Тем более, что функция автора ветки, кажется, будет максимальной по времени.
← →
Knight © (2003-12-22 19:33) [20]>> Sha © (22.12.03 17:26) [17]
> а почему вызываешь так:
> A:=Explode(false," Имеется переменная String как ее разбить на символы?");
Sorry... не с той кнопки скопировал... :)
A:=Explode(" Имеется переменная String как ее разбить на символы?");
> Тем более, что функция автора ветки, кажется, будет максимальной по времени.
Почему?
← →
Sha © (2003-12-22 19:44) [21]> Knight © (22.12.03 19:33) [20]
>> Тем более, что функция автора ветки, кажется, будет максимальной по времени.
> Почему?
SetLength(Result,Length(Result)+1);вызывается для каждой буквы каждого слова. А это даже не две функции, как тебе показалось :)
Result[High(Result)]:=Copy(Str,k+1,i-k-1);вызывается для каждой буквы каждого слова. И здесь тоже не две функции, как тебе показалось :)
← →
Knight © (2003-12-22 19:52) [22]> Sha © (22.12.03 19:44) [21]
А если по внимательнее посмотреть... может для каждого слова в предложении?
← →
Knight © (2003-12-22 19:54) [23]В смысле набора символов между двумя разделителями...
← →
Sha © (2003-12-22 19:58) [24]> Knight © (22.12.03 19:52) [22]
Да, точно. Недосмотрел.
Но все равно, если из Sha_RightMarkedTextToWords выбросить лишнее,
то она побыстрее будет.
← →
Knight © (2003-12-22 23:24) [25]>> Sha © (22.12.03 19:58) [24]
Согласен.
С моей цикл на 1.000.000 работает 0:0:6:313.
С твоей (очищенной от лишнего) 0:0:5:422.
А вот следующий вариант выполняется за 0:0:3:547. Хотя если объеденить твой и мой будет ещё меньше, примерно, на секунду :)
function Explode(Str:String):TStrArr;
var i,k,n,LenStr,LenArr:Integer;
Ch:Char;
begin
Result:=nil;
LenStr:=Length(Str);
if LenStr>0 then begin
Ch:=Str[1];
LenArr:=0;
for i:=2 to LenStr do if (Str[i]=Ch) then Inc(LenArr);
SetLength(Result,LenArr+1);
k:=1;
n:=1;
for i:=0 to LenArr do begin
Inc(n);
while (n<=LenStr) and (Str[n]<>Ch) do Inc(n);
Result[i]:=Copy(Str,k+1,n-k-1);
k:=n;
end;
end;
end;
← →
Style © (2003-12-22 23:46) [26]Только чета ваши функции на PHP explode не похожи совсем
function Explode($Separator, $Text) = Array
Причем $Separator - это тоже string;
← →
Knight © (2003-12-23 00:08) [27]>> Style © (22.12.03 23:46) [26]
Ну мне полный аналог и не надо... главное, чтобы строку перегоняло в массив и ладно. :)
← →
Fantasist © (2003-12-23 01:41) [28]procedure GetWords(WordList:TStrings; Text:string; Delimiters:set of char);
var
st,cur:pchar;
tmp:string;
len:Cardinal;
begin
cur:=pointer(text);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;
while cur^<>#0 do
begin
inc(cur);
if cur^ in Delimiters then
begin
len:=Cardinal(cur)-Cardinal(st);
SetLength(tmp,len);
move(st^,pointer(tmp)^,len);
WordList.Add(tmp);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;
end;
end;
end;
← →
Style © (2003-12-23 02:03) [29]Вот написал!
type
TStringArray = Array of string;
function Explode(Separator, Text: string): TStringArray;
var
acount,i, spos: integer;
textaddr,textsize,sepsize: integer;
function getstrlen(address: integer ): integer;
asm
lea eax, pointer(address)
sub eax, $04
mov eax, [eax]
mov result, eax
end;
function getaddr(pstring: pointer ): integer;
asm
lea eax, pointer(pstring)
mov eax, [eax]
mov result, eax
end;
function copyfromaddr(address, pos, count: integer): string;
var
memsize: integer;
mem: pchar;
begin
memsize := count+1;
getmem(mem,memsize);
zeromemory(mem,memsize);
copymemory(mem,pchar(address+pos-1),count);
result := mem;
freemem(mem);
end;
function scanfrompos(pos: integer): boolean;
var j: integer;
begin
result := false;
for j := 1 to sepsize do
begin
if(Text[pos+j] <> separator[j]) then exit;
end;
result := true;
end;
begin
textaddr := GetAddr(@Text);
if(textaddr = 0) then exit;
textsize := GetStrLen(textaddr);
sepsize := GetStrLen(GetAddr(@Separator));
i := $1;
acount := i;
spos := i;
while i < textsize+1 do
begin
if(scanfrompos(i-1)) then
begin
if(spos <> i) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,i-spos);
Inc(Acount);
i := i + sepsize;
spos := i;
end;
end
else
Inc(i);
end;
if(spos <= textsize) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,textsize-spos+1);
end;
end;
← →
Fantasist © (2003-12-23 02:07) [30]
> Knight © (22.12.03 23:24) [25]
Ты не учитываешь, что символы разделители могут идти подряд. Если нужно именно массив, то можно сделать так:
function GetWords(Text:string; Delimiters:set of char):TStrArr;
var
st,cur:pchar;
tmp:string;
len,count:Cardinal;
begin
count:=0;
SetLength(Result,0);
//пропустим разделители
cur:=pointer(text);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
if cur^=#0 then exit;
st:=cur;
//сосчитаем слова
while (cur^<>#0) do
begin
inc(cur);
if (cur^ in Delimiters) do
begin
inc(count);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
end;
end;
SetLength(Result,count+1);
count:=0;
cur:=st;
while cur^<>#0 do
begin
inc(cur);
if cur^ in Delimiters then
begin
len:=Cardinal(cur)-Cardinal(st);
SetLength(Result[count],len);
move(st^,pointer(Result[count])^,len);
inc(count);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;
end;
end;
//последнее слово
len:=Cardinal(cur)-Cardinal(st);
SetLength(Result[count],len);
move(st^,pointer(Result[count])^,len);
end;
← →
Style © (2003-12-23 02:11) [31]Блин скока алгоритмов народ ужо насочинял :)
Дальше чувствую чистый машинный код пойдет или реализацию Explode с помощью MMX технологий хто нить забубенит!
8-)
← →
Fantasist © (2003-12-23 02:14) [32]Единственно что перед параметром Text надо const написать.
← →
Fantasist © (2003-12-23 02:20) [33]
> Дальше чувствую чистый машинный код пойдет или реализацию
> Explode с помощью MMX технологий хто нить забубенит!
Это лишнее. Все прекрасно и оптимально реализуется средствами Дельфийского Паскаля. У тебя в коде идея правильная, только не до конца отточеная.
← →
Style © (2003-12-23 02:30) [34]Вот отточил 8)
Кстати можно ускорить
1) сравнивать по слову (32 бита) c разделителем
2) массив создавать в конце вызывая setlength - 1 раз.
function Explode(Separator, Text: string): TStringArray;
var
acount,i, spos: integer;
textaddr,textsize,sepsize: integer;
function getstrlen(address: integer ): integer;
asm
lea eax, pointer(address)
sub eax, $04
mov eax, [eax]
mov result, eax
end;
function getaddr(pstring: pointer ): integer;
asm
lea eax, pointer(pstring)
mov eax, [eax]
mov result, eax
end;
function copyfromaddr(address, pos, count: integer): string;
var
memsize: integer;
mem: pchar;
begin
memsize := count+1;
getmem(mem,memsize);
zeromemory(mem,memsize);
copymemory(mem,pchar(address+pos-1),count);
result := mem;
freemem(mem);
end;
function scanfrompos(pos: integer): boolean;
var j: integer;
begin
result := false;
for j := 1 to sepsize do
begin
if(Text[pos+j] <> separator[j]) then exit;
end;
result := true;
end;
begin
textaddr := GetAddr(@Separator);
if(textaddr = 0) then
begin
SetLength(result,1);
result[0] := text;
exit;
end;
sepsize := GetStrLen(textaddr);
textaddr := GetAddr(@Text);
if(textaddr = 0) then exit;
textsize := GetStrLen(textaddr);
i := $1;
acount := i;
spos := i;
while i < textsize+1 do
begin
if(scanfrompos(i-1)) then
begin
if(spos <> i) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,i-spos);
Inc(Acount);
i := i + sepsize;
spos := i;
end else
begin
Inc(Acount);
i := i + sepsize;
spos := i;
end;
end
else
Inc(i)
end;
if(spos <= textsize) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,textsize-spos+1);
end;
end;
← →
Knight © (2003-12-23 09:21) [35]>>Fantasist © (23.12.03 02:07) [30]
У меня всё верно. Если разделители повторяются, то считается, что между ними пустая строка ""
>> Style
Ещё не дочитал и не попробовал... коментарий позже... :)
← →
Style © (2003-12-23 09:35) [36]2 Knight :)
Хочу коментариЙ!!!!! Ж8)
← →
Style © (2003-12-23 11:28) [37]Не, ну как функция???
Первый раз чегото с использованием asm попробывал наваять :)
← →
Knight © (2003-12-23 12:03) [38]>> Style © (23.12.03 11:28) [37]
Более 10 секунд... :)
← →
Sha © (2003-12-23 12:55) [39]> Style © (23.12.03 11:28) [37]
> Первый раз чегото с использованием asm попробывал наваять :)
mov result, eax
Это лишнее.
Да и вообще, если писать на Pascal без вызова asm-функций, было бы быстрее :)
← →
Knight © (2003-12-23 12:59) [40]Пока самое быстрое у Fantasist © (23.12.03 02:07) [30]
На 3 сотни миллисекунд быстрее моего.
Хотя лишнего тоже много... :)
Страницы: 1 2 вся ветка
Текущий архив: 2004.01.16;
Скачать: CL | DM;
Память: 0.58 MB
Время: 0.888 c
