Удаление подстрок из строки за один проход

[Pcrepair]

Добрый день. Есть функция на основе цикла FOR для удаления подстрок из строки за один проход

(*  09.02.2013  Функция удаления ненужных тегов с содержимым
  Список тегов: script; style; noscript; applet; object
  textarea; audio; button; canvas; comment; datalist; del;
  meter; noembed; optgroup; output; progress. удаление за один проход*)

function DelUseless(const Data:string):string;
var
I,EndTeg,Differ:integer;
Buffer:string; (*накопитель полезных символов*)
DefineTeg:string; (*первые 10 символов после <*)
begin
Differ:=0;
 if Length(Data) = 0 then Exit else
 for I := 1 to Length(Data) do

  begin
   if (Data[I] = '<') then  (*ловим открывающий символ*)
    begin
     DefineTeg:=Copy(Data, I,10); (*получаем десять символов от открывающего*)
      if (PosEx('<script', DefineTeg,1)= 0) then  (*если там нет '<script'*)
        Buffer:=Buffer+Data[I] (*копируем символ в буфер ЕСЛИ не <script*)
      else
        begin
          EndTeg:=PosEx('</script>',Data,I); (*определяем замыкающий тег*)
            if (EndTeg > 0) then Differ:=(EndTeg - I + 9); (* вычисляеи число символов от и до;*)
        end
        end
        else
          if (Differ = 0) then Buffer:=Buffer+Data[I] (*копируем посимвольно в буфер ЕСЛИ не <*)
          else Dec(Differ, 1) (*с каждым тактом в цикле уменьшаем счетчик числа символов в <script hghg>hghghgh</script>*)
  end;
 Result:=Buffer;
end;

Функция почемуто работает не совсем корректно, в частности строку
1<script>2</script>3 4<script>5</script>6
трансформирует в
1< 4<
а должно быть
13 46

Подскажите, кто в курсе, в чем ошибка?
З.Ы. Цикл FOR используется для того чтобы в затем ввести CASE при выборе тега для обработки и как самый быстрый вариант(один проход от первого символа до последнего в строке)

[Sibedir]

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

function DelUseless2(const Data:string):string;
var
  O1, O2: Integer;
begin
  Result := Data;
  O1 := 1;
  while True do begin
    O1 := Pos('<script>', Result, O1);
    if O1 = 0 then Break
    else begin
      O2 := Pos('</script>', Result, O1+8);
      if O2 = 0 then Break
      else begin
        Delete (Result, O1, O2+9-O1);
      end;
    end;
  end;
end;

___________________________________ ___________________________________ ________
Вот, немного оптимизировал. Избавился от Delete и записываю результат посимвольно:

function DelUseless1 (Data: String): String;
var
  o1, o2, i, s, d, L: Integer;
begin
  L := Length (Data);
  SetLength (Result, L);
  o1 := 1;
  s := 1;
  d := 0;
  while True do begin
    o1 := Pos('<script>', Data, s);
    if o1 = 0 then Break
    else begin
      o2 := Pos('</script>', Data, o1+8);
      if o2 = 0 then Break
      else begin
        for i := s to o1-1 do
          Result[i-d] := Data[i];
        s := o2 + 9;
        d := d + (s - o1);
        o1 := s;
      end;
    end;
  end;
  for i := s to L do
    Result[i-d] := Data[i];
  SetLength (Result, L-d);
end;

Дало прирост в скорости ~ 50%.
___________________________________ ___________________________________ ________
На Lazarus'e ~ 15%
А в целом скорость на Lazarus'e раза в 2 меньше

[Pcrepair]

Спасибо за ответ, НО.....
1. код на базе while и repeat уже есть. работает
2. "Мало того, что понять логигу его работы очень сложно и в нем где-то ошибка, так еще и работает долго. " - поясняю, используется код на базе цикла FOR(удаление подстрок за ОДИН проход строки):
- берется символ соответсвующий значению счетчика цикла
- если нет условия то символ копируется в буфер
- если есть условие = '<', тогда проверяем дальше есть ли условие = '<script'(если да, тогда вычисляем число символов Differ в конструкции <script ghghg>fcgfgfgfgfg</script>
- если условия нет(<a> к примеру), тогда символ копируется
- если условие есть, тогда запрещаем копирование в буфер, пока Differ не равен нулю, при этом в каждом такте уменьшаем Differ на еденицу. при этом после последнего символа конструкции возобновляется копирование символов в буфер, если конечно нет условия
- ну и в конце цикла результат передается на выход функции

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

[Sibedir]

эта версия должна быть самой быстрой и максимально логичной.

никому она ничего не должна
-----------------------------------------------------------------------------------------------------------------------------------------------

жаль что нельзя менять состояние счетчика цикла, было бы еще проще

Для этого While и существует. А вот это вот ваше

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

аля

          if (Differ = 0) then Buffer:=Buffer+Data[I] (*копируем посимвольно в буфер ЕСЛИ не <*)
          else Dec(Differ, 1) (*с каждым тактом в цикле уменьшаем счетчик числа символов в <script hghg>hghghgh</script>*)

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

Buffer:=Buffer+Data[I]

Динамически менять размер буфера - это очень не красиво. Лучше сразу установить буфер достаточной длины (без фанатизма, конечно), а после - обрезать.

[evg_m]

жаль что нельзя менять состояние счетчика цикла, было бы еще проще

Вот то-то и оно.
полсе того как

если условие есть, тогда запрещаем копирование в буфер, пока Differ не равен нулю,

позиция-то не сдвинулась т.е '<' текущий символ
и в полном соответствии с описанием копируем нужное число символов (1)
итого '1<'

[Sibedir]

Кстати, если уж сравнивать производительность циклов, нелишним было бы посмотреть вот на это (ниже приведен код и то, что откомпилировало Delphi):
Вариант 1 - использование repeat..until

function funcUntil: Integer;
var
  i: Integer;
begin
  i := 1;
  repeat
    Result := i;
    Inc (i);
  until i = H;
end;

PHP код:

005A81D4 55               push ebp
005A81D5 8BEC             mov ebp,esp
005A81D7 83C4F8           add esp,-$08
005A81DA C745F801000000   mov [ebp-$08],$00000001
005A81E1 8B45F8           mov eax,[ebp-$08]
005A81E4 8945FC           mov [ebp-$04],eax
005A81E7 FF45F8           inc dword ptr [ebp-$08]
005A81EA 817DF800CA9A3B   cmp [ebp-$08],$3b9aca00
005A81F1 75EE             jnz $005a81e1
005A81F3 8B45FC           mov eax,[ebp-$04]
005A81F6 59               pop ecx
005A81F7 59               pop ecx
005A81F8 5D               pop ebp
005A81F9 C3               ret 
005A81FA 8BC0             mov eax,eax 


Вариант 2 - использование for

function funcFor: Integer;
var
  i: Integer;
begin
  for i := 1 to H do
    Result := i;
end;

PHP код:

005A81AC 55               push ebp
005A81AD 8BEC             mov ebp,esp
005A81AF 83C4F8           add esp,-$08
005A81B2 C745F801000000   mov [ebp-$08],$00000001
005A81B9 8B45F8           mov eax,[ebp-$08]
005A81BC 8945FC           mov [ebp-$04],eax
005A81BF FF45F8           inc dword ptr [ebp-$08]
005A81C2 817DF801CA9A3B   cmp [ebp-$08],$3b9aca01
005A81C9 75EE             jnz $005a81b9
005A81CB 8B45FC           mov eax,[ebp-$04]
005A81CE 59               pop ecx
005A81CF 59               pop ecx
005A81D0 5D               pop ebp
005A81D1 C3               ret 
005A81D2 8BC0             mov eax,eax 


Как видите, никакой разницы. И хотя while в данном случае даст несколько иной байт-код, его производительности будет точно такой же.
Так что использование конструкции for никоим образом не гарантирует более высокую производительность, а в некоторых случаях (как у вас) неоправданное стремление юзать именно for приводит к её снижению.

[Pcrepair]

Сообщение от Sibedir

Вообще, если заниматься оптимизацией, то впервую очередь нужно было избавиться от

Buffer:=Buffer+Data[I]

Динамически менять размер буфера - это очень не красиво. Лучше сразу установить буфер достаточной длины (без фанатизма, конечно), а после - обрезать.

Buffer:=Buffer+Data[I] а чем это плохо конкретно? мне нужно чтобы код работал без сбоев и быстро

что касается использования цикла FOR, там ведь идет посимвольное копирование(если не запрещено), что может быть быстрее? чем пройтись по символам?
к тому же далее будет усложнение условий запрета на копирование
на самом деле есть несколько десятков разновидностей тегов вида <fgf hghghg>fghfgfgfgfgf</fgf>. далее будет оператор CASE и ветвление логики обработки. и все это в одном такте цикла, без внутренних дополнительных циклов.
разве такой вариант не будет быстрее
вот кстати полностью рабочая версия функции

function DelUseless(const Data:string):string;
var
I,EndTeg,Differ:integer;
Buffer:string; (*накопитель полезных символов*)
DefineTeg:string; (*первые N символов после <*)
begin
Differ:=0;
 if Length(Data) = 0 then Exit else
   for I := 1 to Length(Data) do
   (*-----------------ЦИКЛ-----------------------------*)
     begin
     if Differ > 0 then Dec(Differ) else
       if (Data[I] = '<') then
         begin
           DefineTeg:=Copy(Data, I,10);
             if (PosEx('<script', DefineTeg,1)= 0) then
             Buffer:=Buffer+Data[I] (*копируем символ в буфер ЕСЛИ не <script*)
          else
         (*определяем замыкающий тег; вычисляеи число символов от и до;*)
            begin
             EndTeg:=PosEx('</script>',Data,I);  (*9 символов*)
               if (EndTeg > 0) then Differ:=(EndTeg - I + 8);
            end
          end
        else
       Buffer:=Buffer+Data[I]
     end;
    (*-----------------конец-----------------------------*)
   Result:=Buffer;
end;

[evg_m]

Buffer:=Buffer+Data[I] а чем это плохо конкретно? мне нужно чтобы код работал без сбоев и быстро

Обращением к ресурсоемким (медленным!) функциям по выделению куска памяти (да еще и с копированием данных по памяти).

// вот что на самом делает Buffer+Data[i]
newbuff:=GetMembuff(length(oldbuff)+1);//медленно! надо найти свободное место в списках свободной памяти зарезервировать его чтобы никто другой не ухватил
copydata(oldbuff, newbuff, length(oldbuff);// копирование данных чем длиннее строка тем медленнее! 
newbuff[length(oldbuff)]:=Data[i]; 
FreeBuff(oldBuff); //тоже может быть не очень быстро

Динамически менять размер буфера - это очень не красиво. Лучше сразу установить буфер достаточной длины (без фанатизма, конечно), а после - обрезать.

Вместо N выделений только одно!
Туда же (к медленному перераспределению памяти) относятся Сopy/Delete/....

Избавился от Delete и записываю результат посимвольно:

Дало прирост в скорости ~ 50%.

[Sibedir]

Buffer:=Buffer+Data[I] а чем это плохо конкретно? мне нужно чтобы код работал без сбоев и быстро

К словам evg_m от себя добавлю:

Buffer:=Buffer+Data[I]

и

Inc(j);
Buffer[j]:=Data[i]

не одно и тоже. Код типа Buffer:=Buffer+Data[I] может заставить программу создавать новый буфер и полностью копировать туда старый. Т.е. при каждом такте вашего цикла буфер будет перезаписываться снуля. А Buffer[j]:=Data[i] просто прочитает один байт и запишет один байт.
------------------------------------------------------------------------------------------------------------------------

что касается использования цикла FOR, там ведь идет посимвольное копирование(если не запрещено), что может быть быстрее? чем пройтись по символам?

Пройтись по символам грамотно. И это не простая ирония в ваш адрес. Для посимвольного прохода по строке for не самая лучшая конструкция. Точнее сказать лучшей нет. Всё зависит от конкретной задачи. Конкретно для вашей задачи for не подходит. По крайней мере, я не могу придумать более-менее вразумительного алгоритма с применением for.
------------------------------------------------------------------------------------------------------------------------

вот кстати полностью рабочая версия функции

Не примите за придирку, но коль скоро зашла речь о скорости:
Время выполнения 10000000 итераций:
вариант из поста #7 - 4,25 сек
2-ой вариант из поста #2 - 1,08 сек

[Pcrepair]

может Я чего не понял? но замена Buffer:=Buffer+Data[I] на

function DelUseless(const Data:string):string;
var
Len,I,EndTeg,Differ,j:integer;
Buffer:string; (*накопитель полезных символов*)
DefineTeg:string; (*первые N символов после <*)
starttime,endtime,q:int64;
begin      starttime:=GetTickCount;
  Differ:=0;
  j:=0;
  if Length(Data) = 0 then Exit else
    for I := 1 to Length(Data) do
   (*-----------------ЦИКЛ-----------------------------*)
     begin
     if Differ > 0 then Dec(Differ) else
      if (Data[I] = '<') then
        begin
          DefineTeg:=Copy(Data, I,10); 
          if (PosEx('<script', DefineTeg,1)= 0) then

          //Buffer:=Buffer+Data[I] (*копируем символ в буфер ЕСЛИ не <script*)
          begin
            Inc(j);
            Buffer[j]:=Data[i];
          end

          else
         (*определяем замыкающий тег; вычисляеи число символов от и до;*)
            begin
             EndTeg:=PosEx('</script>',Data,I);  (*9 символов*)
               if (EndTeg > 0) then Differ:=(EndTeg - I + 8);
            end
        end
        else
          //Buffer:=Buffer+Data[I]
          begin
            Inc(j);
            Buffer[j]:=Data[i];
          end

     end;
    (*-----------------конец-----------------------------*)
   Result:=Buffer;

   endtime:=GetTickCount;
   q:=endtime-starttime;  ShowMessage('Число циклов = '+IntToStr(q));

end;

в соотвествующих местах привела только к AV(First chance exception at $005ACC85. Exception class $C0000005 with message 'access violation at 0x005acc85: write of address 0x00000000'. Process GetText.exe (1916))

нельзя ли поподробнее?