Форум на Исходниках.RU

Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=271319 Fri, 26 Dec 2003 23:10:42 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=271319 Ну раз уж пошла такая пьянка, вот мой вариант. Работает по тому же принципу, что и ввод вывод в файлы.

const
s:string='123ababcc456abcabc78ababc';
fs:string='a';
ns:string='defgh';

function strreplace(var s:string;fs,ns:string):integer;
var
ts:string;
p,k,n:byte;
begin
strreplace:=-1;
if s+fs+ns='' then exit;
k:=1;
p:=1;
ts:='';
n:=0;
while p<=byte(s[0])do
begin
if s[p]=fs[k] then
begin
if k<byte(fs[0]) then inc(k) else
begin
ts:=ts+ns;
inc(n);
k:=1;
end;
end else
begin
dec(p,k-1);
ts:=ts+s[p];
k:=1;
end;
inc(p);
end;
s:=ts;
strreplace:=n;
end;
begin
strreplace(s,fs,ns);
writeln(':',s,':');
end.

]]> Some1 Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122214 Fri, 15 Aug 2003 11:39:19 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122214 vesper1 Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122213 Fri, 15 Aug 2003 08:18:49 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122213

function ReplaceAll( S : string; const Search, Replace : string ) : string;

var

P : byte;

begin

P := Pos( Search, S );

if P <> 0 then

begin

Delete( S, P, Length( Search ) );

Insert( Replace, S, P );

ReplaceAll := Copy( S, 1, P + Length( Search ) - 1 ) + ReplaceAll( Copy( S, P + Length( Search ), Length( S ) - ( P + Length( Search ) ) + 1 );

end

else

ReplaceAll := S;

end;

]]> Favst Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122212 Fri, 15 Aug 2003 06:04:30 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122212

function isthere(var wher:string;p:integer;var whattoseek:string):boolean;

var i:integer;

b:boolean;

begin

b:=true;

i:=0;

while b and i<min(length(wher)-p,length(whattoseek)) do begin

b:=wher[p+i]=whattoseek[i+1];

inc(i);

end;

isthere:=b;

end;

procedure replaceall(var wher:string;whattoseek:string;towhat:string);

var p:integer;

begin

p:=1;

while p<length(wher)-length(whattoseek)+1 do begin

if iswhere(wher,p,whattoseek) then begin

delete(wher,p,length(whattoseek));

insert(towhat,wher,p);

p:=p+length(towhat);

end else inc(p);

end;

end;

Проверяй, мне нельзя на работе.]]> vesper1 Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122211 Fri, 15 Aug 2003 01:42:28 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122211 Цитата

Хорошая критика всегда полезна!
Предлагайте решение :)

Дык, я же уже предложил ::)]]> Mixxx Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122210 Thu, 14 Aug 2003 17:20:02 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122210 Предлагайте решение :)]]> vot Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122209 Thu, 14 Aug 2003 17:05:57 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122209 Цитата

Жуть... ну и наворотил :)))

То вы жалуетесь что комментариев мало то
наоборот слишком много, да вам неугодишь :)
А вообще в таких случаях лучше всего поступать по методу
Сонга - положить эти функции в какой нить модуль и забыть про них ;D

Цитата

Глянь на мою поделку:

Ой, буду критиковать :)
Даже если закрыть глаза на врождённую короткость string'ового типа
и многочисленные лишние перемещения символов туда-сюда
(вместо одного направленного их перемещения сразу в конечное
положение как у меня :) ) Я немогу пропустить мимо глас явный баг:
Попробуйте с помощью своей процедуры заменить
в строке ' ляляля_ЛЕС_ляля тополя'
подстроку 'ЛЕС' на строку 'ЛЕСОПОВАЛ'

Вот готовая прога пытающася это проделать

uses crt;

{Replace all "Search" substrings to "Repl" substrings in the "S" string}

Function ReplaceAll(S:string;const Search,Repl:string):String;

var p:byte;

begin

Repeat

p:=Pos(Search,S);

If p>0 then begin

Delete(S,p,Length(Search));

Insert(Repl,S,p);

end;

until (p=0);

ReplaceAll:=S;

end;

var s:string;

begin clrscr;

s:='лялляля_ЛЕС_лялялятополя';

writeln('Перед заменой: ',s);

write('Для выхода рекоммендую Сtrl+Break')

write('После замены: ',ReplaceAll(s,'ЛЕС','ЛЕСОПОВАЛ'));

readln;

end.

ЗЫ Простите если был слишком резок.]]> Mixxx Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122208 Thu, 14 Aug 2003 13:50:35 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122208 Глянь на мою поделку:

{-----------------------------------------------}

{Replace all "Search" substrings to "Repl" substrings in the "S" string}

Function ReplaceAll(S:string;const Search,Repl:string):String;

var p:byte;

begin

Repeat

p:=Pos(Search,S);

If p>0 then begin

Delete(S,p,Length(Search));

Insert(Repl,S,p);

end;

until (p=0);

ReplaceAll:=S;

end;

]]> vot Pascal https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122207 Thu, 14 Aug 2003 13:11:39 +0000 Эффективный Replace ALL https://forum.sources.ru/index.php?showtopic=14403&view=findpost&p=122207
Написать сие, меня побудил вот этот фрагмент кода на дельфи

function StringReplaceAll (text,byt,mot : string ) :string;
{Funktion for att byta ut alla forekomster av en strang mot en
annan strang in en strang. Den konverterade strangen returneras.
Om byt finns i mot maste vi ga via en temporar variant!!!}
var
plats : integer;
begin
While pos(byt,text) > 0 do
begin
  plats := pos(byt,text);
  delete (text,plats,length(byt));
  insert (mot,text,plats);
end;
result := text;
end;

Думаю коментарии излишни.

{
Представленная ниже функция
lreplace(kogo,chem,gde:Pchar):integer;
Находит в строке gde все подстроки kogo и заменяет их на строку chem.
А возвращает количество сделанных замен или -1 если ошибка.

Примечательно что ниже описанный алгоритм НЕ трубует дополнительного
буфера для cтроки gde.

Вся работа проходит в три этапа
1.находим все вхождения строки kogo в строку gde и записываем их в массив z а количество вхождений в переменную kol
2.аккуратно переписываем участки строки gde, которые размещены, между найдеными подстроками, на их новое место(всё в тойже строке gde).
3.пишем строку-замену kol раз, в тех местах (строки gde) где это необходимо.

==================== Этап 1 ==========================
Эфективные алгоритмы поиска подстроки в строке ещё более сложны чем этот.
Поэтому чтобы непариться просто воспользуемся стандартной функцией из модуля
Strings - strpos, слегка её модифицировав (чтобы она начинала искать
подстроку с заданой позиции) в функцию
lstrposi(kogo,gde:pchar;start:integer):integer;(lstr в стиле WinAPI :))
kogo    подстрока которую будем искать
gde строка в которой будет производится поиск
start index начиная с которого будем искать
возращает -1 если ничего ненашли или найденую позицию подстроки в случае успеха

==================== Этап 2 ==========================
Далее условимся что
Lenkogo:=strlen(kogo);
Lenchem:=strlen(chem);
Len:=strlen(gde);
kol:=количество найденных вхождений (образцов)

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

   0 z[1]-1
z[1]+Lenkogo z[2]-1
z[2]+Lenkogo z[3]-1
...........................
z[i]+Lenkogo z[i+1]-1
...........................
z[kol]+Lenkogo len

(
А сами образцы расположены так (хотя эта инфа нам не пригодится)
z[1] z[1]+Lenkogo-1
z[2] z[2]+Lenkogo-1
...............................
z[i] z[i]+Lenkogo-1
...............................
z[kol] z[kol]+Lenkogo-1
)

Если z[0]:=-Lenkogo и z[kol+1]:=len+1 то тоже самое запишем так:

z[0]+Lenkogo z[1]-1
z[1]+Lenkogo z[2]-1
z[2]+Lenkogo z[3]-1
..............................
z[i]+Lenkogo z[i+1]-1
..............................
z[kol]+Lenkogo z[kol+1]-1

Наша цель переписать эти участки так:
(после того как мы это осуществим, 90% всей работы будет сделано)
z[0]+Lenkogo+raz*0 z[1]-1+raz*0
z[1]+Lenkogo+raz*1 z[2]-1+raz*1
z[2]+Lenkogo+raz*2 z[3]-1+raz*2
..........................................
z[i]+Lenkogo+raz*i z[i+1]-1+raz*i
..........................................
z[kol]+Lenkogo+raz*kol z[kol+1]-1+raz*kol

т.е. отодвинуть i-тый участок на растояние = raz*i
raz=Lenchem-Lenkogo; т.е. разность му длиннами заменяемой подстроки и строкой для замены
Основная трабла в том чтобы во время отодвигания текущего символа
незатронуть будущий (который нам только предстоит отодвинуть)
Чтобы этого избежать поступим следующим образом:
если Lenchem<Lenkogo
то начнём отодвигать стартуя от нулевого символа
иначе начнём отодвигать стартуя от последнего символа

==================== Этап 3 ==========================
Тут уже нам ненадо бояться что мы чего-нибудь запортачим,
ведь переписывать мы будем из строки chem в gde,
а не из gde в gde (как это было на этапе 2).
Остаёться токо вычислить координаты в которые следует
записать строчку chem, вот они:
z[1]+raz*0 z[1]+raz*0+Lenchem-1
z[2]+raz*1 z[2]+raz*1+Lenchem-1
z[3]+raz*2 z[3]+raz*2+Lenchem-1
....................................................
z[i]+raz*(i-1) z[i]+raz*(i-1)+Lenchem-1
....................................................
z[kol]+raz*(kol-1) z[kol]+raz*(kol-1)+Lenchem-1

======================================================
Все пунктационные и орфографические ошибки являются интеллектуальным достоянием автора, при перепечатке их исправление запрещено :)))
© Mixxx 2002-2003
}

program replace;
{$X+}
uses Strings,crt;
type pstr=Pchar;
var
s,sub,zam:string[255];

function lstrposi(kogo,gde:pchar;start:integer):integer;
var b:pstr;
   p:pstr;
begin
if start>strlen(gde)
then lstrposi:=-1
else
  begin
   p:=@(gde[start]);
   b:=strpos(p,kogo);
   if b=nil then lstrposi:=-1
   else lstrposi:=b-p+start;{Любопытная весчь - b и p имеют тип Pchar, а результат выражения (b-p) -тип integer }
  end;
end;

  function lreplace(kogo,chem,gde:pstr):integer;
  const max=99;
  var raz,t,p,nach,kol,res,dl,lenkogo,len,lenchem:integer;
   z:array[0..max+1] of integer;{//0 для служ целей}
  begin
   kol:=0;
   lenkogo:=strlen(kogo);

   p:=lstrposi(kogo,gde,0);
   while (p<>-1)and(kol<=max) do begin
   inc(kol);
   z[kol]:=p;{запоминаем вхождение}
   p:=lstrposi(kogo,gde,p+lenkogo);{ищем след. вхождение стартуя от конца предыдущего}
   end;
   if kol=0 then begin lreplace:=kol;exit;end;{заменять нечего}
   if kol=max+1 then begin write('Нехватает памяти'); lreplace:=-1;exit;end;

   {//теперь заменяем}
   lenchem:=strlen(chem);
   len:=strlen(gde);
   dl:=len+kol*(lenchem-lenkogo);{будущая длинна строки gde}
   raz:=lenchem-lenkogo;{разность lenchem и lenkogo :)}
   z[0]:=-lenkogo;
   z[kol+1]:=len+1;
   if lenchem>lenkogo then{//c конца}
   begin {//dl>len}
   {идём от конца к началу}
   for t:=kol downto 0 do
   begin
   res:=raz*t;
   for p:=z[t+1]-1 downto z[t]+lenkogo do
   gde[p+res]:=gde[p];
   end;
   end {//then}
   else {//с начала}
   begin
   {//dl<len}
   {идём от начала к концу}
   for t:=0 to kol do
   begin
   res:=raz*t;
   for p:=z[t]+lenkogo to z[t+1]-1 do
   gde[p+res]:=gde[p];
   end;
   end;{//else}
   {теперь препишем строки}
   for t:=1 to kol do
   begin
   nach:=z[t]+raz*(t-1);
   for p:=nach to nach+lenchem-1 do
   gde[p]:=chem[p-nach];
   end;
   gde[dl+1]:=#0;
   lreplace:=kol;
  end;

var p:pstr;
begin
clrscr;

write('Где будем заменять?'); readln(s);s:=s+#0;
write('Что будем заенять?'); readln(sub);sub:=sub+#0;
write('На что будем заменять?'); readln(zam);zam:=zam+#0;

lreplace(@sub[1],@zam[1],@s[1]);{@s[1] эта какбы string2Pchar}
p:=@s[1];
write('Результат ',p);{печатаем s как Pchar а не как string}
readln;
end.

PS А есть способ оптималнее вышеописанного?
PSS Варианты типа - на асме будет быстрее НЕ предлагать, меня сейчас волнует алгоритмическая оптимизация. ]]> Mixxx Pascal