Удалить буквы из строки до и после символа

[Славян]

Что-то я нисколько не вижу, где у вас идёт анализ ДО знака '='? Похоже, что вы просто все совпадения из второго списка ищете и убираете во всей строке.
Или как?

[Kirilis2018]

Славян, Вот тут же анализ до и после знака "=".
В самой procedure Working:

then _L1.Strings[i] := Format('%s=%s', [s, _L1.ValueFromIndex[i]])
 else _L1.Strings[i] := Format('%s=%s', [_L1.Names[i], s]);

Сообщение отредактировано: Kirilis2018 - 02.02.19, 16:58

[Славян]

Допускаю, что такие тормоза идут оттого, что строка s сама на себя многократно копируется, а это всё же весьма медленно.
Есть жуткий режим (крайне низкоуровневый), кой бы ускорил на порядок. Пример:
s = "Мама мыла раму, да и рама мылась мамой";
Memo3 = "ма", "мы", "а";

В вашем коде:
1шаг) s = " мыла раму, да и ра мылась мой";
2шаг) s = " ла раму, да и ра лась мой";
3шаг) s = " л рму, д и р лсь мой";

Да и сам вызов StringReplace весьма тяжек, наверняка.

Если же делать так:
1) t = length(s);
2) ищем все слова из Memo3 и ставим нули на найденном (здесь и идёт низкоуровневая функция):
1 шаг) s = "0000 мыла раму, да и ра00 мылась 00мой";
2 шаг) s = "0000 00ла раму, да и ра00 00лась 00мой";
3 шаг) s = "0000 00л0 р0му, д0 и р000 00л0сь 00мой";
а потом собрать все не нули до t в новую строку, то должно получиться быстрее.

Добавлено 02.02.19, 17:10

Цитата Kirilis2018 @ 02.02.19, 16:57

Вот тут же анализ до и после знака "=".
В самой procedure Working:

Не-не-не! Глядите:

for j := 0 to _L2.Count - 1 do
      s := StringReplace(s, _L2.Strings[j], '', [rfReplaceAll]);

В этой паре строк ищутся все совпадения, невзирая на положение значка '=', и заменяются на пустышку.

[Kirilis2018]

Славян, Ух, теперь я точно запутался . И на этом спасибо, буду дальше думать.

[Руслан]

Цитата Kirilis2018 @ 02.02.19, 16:09

Но скорость просто ужас - ПОМОГИТЕ ОПТИМИЗИРОВАТЬ!

Дело в том, что алгоритм не вполне корректный. Что бы удобней было понимать код и корректность алгоритмов - рекомендуется давать очевидные имена(имена с практической смысловой нагрузкой), к примеру вместо _L1, _L2 что то вроде StrObj_in, StrObj_out(если они таковыми являются). Вам же наверняка не нравится запутанность, не очевидность этапов работы своей же программы...

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

//вернет подстроку, находящуюся слева или справа от разделителя "="
function GetSubStr(StrIn:String; GetInLeft:Boolean):String;
var i_pos_SubStrStart,i_SubStrLength:Integer;
begin
  if GetInLeft then
  begin
    //вычислить позицию подстроки слева от разделителя
    i_pos_SubStrStart:=1;
    i_SubStrLength:=3;
  end else
    begin
      //вычислить позицию подстроки справа от разделителя
      i_pos_SubStrStart:=3;
      i_SubStrLength:=3;
    end;
  //вернуть подстроку
  result:=Copy(StrIn, i_pos_SubStrStart, i_SubStrLength);
end;

функцию дописать(понадобятся pos и length, о которых я упомянул ранее), и её же вызывать по необходимости.

Добавлено 02.02.19, 20:54

Цитата Славян @ 02.02.19, 05:33

А я всегда думал, что это в каком-то начале-прологе...

Топикастер весьма далек от этой главы.

Сообщение отредактировано: Руслан - 02.02.19, 20:54

[Славян]

Цитата Славян @ 02.02.19, 17:07

Да и сам вызов StringReplace весьма тяжек, наверняка.

Действительно, Kirilis2018, гляньте на исходник её (RAD-XE8, System.AnsiString.PAS):

function StringReplace(const S, OldPattern, NewPattern: AnsiString;
  Flags: TReplaceFlags): AnsiString;
var
  SearchStr, Patt, NewStr: AnsiString;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S; // одно лишнее копирование !
    Patt := OldPattern; // второе !
  end;
  NewStr := S; // третье !
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern; // четвёртое !
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt); // пятое !
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt); // шестое !
  end;
end;

6 самых разных копирований классовых агрегатов! В то время как можно обойтись или одним, или вообще без них!!

[Kirilis2018]

Славян, Руслан, Ребята - спасибо! Практически получилось, вот только, еще, некоторые моменты допилить - осталось!

Сообщение отредактировано: Kirilis2018 - 03.02.19, 06:40

[Fr0sT]

Славян, ты, условно, пытаешься задвинуть школьнику про корпускулярно-волновой дуализм. Ни к чему ему это пока.
StringReplace в версиях 10+ допилили, теперь она не такая уж тупая при множественных заменах. Хотя все равно без нужды ее не стоит применять.
А еще, честно говоря, я так и не понял, что ТС-у нужно.

[jack128]

Цитата Славян @ 03.02.19, 03:42

SearchStr := S; // одно лишнее копирование !

в первом, втором и третьем "лишнем копировании" нету копирования тела строк. По сути тут один атомарный инкремент счетчика ссылок происходит.

А вот

NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt); // пятое !

и

SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt); // шестое !

действительно страшные строки.

Но скорее всего тут ничего делать не будут ибо ансистринг только для легаси приложений оставлен.

[^D^ima]

Kirilis2018
А так не быстрее будет?

Я специально не стал использовать лишнее:

procedure TForm1.Button1Click(Sender: TObject);
Var
  FIn,FOut:TextFile;
  SIn,SInPart1,SInPart2:String;
  EqualIndex,I:Integer;
  BadStr1,BadStr2:TStrings;
 
begin
 
BadStr1:= TStringList.Create;
BadStr2:= TStringList.Create;
 
BadStr1:=memo1.Lines;
BadStr2:=memo2.Lines;
 
 
  AssignFile(FIn,'c:\1.txt');
  Reset(FIn);
  AssignFile(FOut,'c:\2.txt');
  Rewrite(FOut);
 
    while not EOF(FIn) do
     Begin
       Readln(FIn,SIn);
       EqualIndex:=Pos('=',SIn);
       SInPart1:=Copy(SIn,1,EqualIndex-1);
       SInPart2:=Copy(SIn,EqualIndex+1,Length(SIn)-EqualIndex);
 
         for I := 0 to BadStr1.Count-1 do SInPart1:=StringReplace(SInPart1,BadStr1[I],'',[rfReplaceAll]);
         for I := 0 to BadStr2.Count-1 do SInPart2:=StringReplace(SInPart2,BadStr2[I],'',[rfReplaceAll]);
 
       WriteLn(FOut,SInPart1+'='+SInPart2);
     End;
 
  CloseFile(FOut);
  CloseFile(FIn);
 
  BadStr1.Free;
  BadStr2.Free;
end;

Добавлено 05.02.19, 00:05
Дальше оптимизировать нужно зная входные данные и пример того что ты пытаешься удалить из них

[Kirilis2018]

^D^ima, Так отлично работает, да, намного быстрее. Спасибо!

Сообщение отредактировано: Kirilis2018 - 05.02.19, 07:55

[Славян]

Вот исключительно эксперимента ради набросал свой StringReplace и получил:

procedure SubStrErase( s,s2,sub:string);
var t,c,lenSub:integer;
begin;
    lenSub := length(sub);
//  s2 := s;
    t := 1;
    while Ord(s[t])<>0 do
    begin
        s2[t] := s[t];
        if s[t]=sub[1] then // начало совпадения слова!?
        begin
            c := 0;
            repeat inc(c); until (s[t+c]<>sub[1+c]); // считаем длину совпадения
            if c=lenSub then
            begin
                repeat dec(c); s2[t+c]:='*'; until (c=0); // ставим символ удаления
                t := t + lenSub; // много совпало - пропустим много
            end else inc(t); // со следующего будет проверка
        end else inc(t); // со следующего будет проверка
    end;
    // удаляем ненужные символы : не доделал, надоело :-(
    t := 1; c := 1;
    while Ord(s2[t])<>0 do
    begin
      if s2[t]='*' then // начало удаляемого
      begin
{       if s2[t+c]='*' then
        begin
            // надо найти неудаляемый и начать записывать его
            repeat inc(c);  until (s2[t+c]<>'*');
        end;
        s2[t] := s2[t+c];   }
      end;
      inc(t);
    end;
end;
...
    str := 'Мама мыла раму с Тамарой. Рама сияла амальгамой';
    s2 := str;
    t1 := GetTickCount;
    for pos:=0 to 1000000 do FileName := StringReplace( str, 'ама', '', [rfReplaceAll]);
    t2 := GetTickCount;
    WriteLn(t2-t1);
    for pos:=0 to 1000000 do SubStrErase( str, s2, 'ама');
    t1 := GetTickCount;
    WriteLn(t1-t2);

На выходе получил: 2000 мс для стандартного StringReplace и около 1000 для своего SubStrErase. Т.е. скорость можно (грубо) увеличить в 2 раза!

[^D^ima]

Славян
А если в целевом тексте будет *, твой код сломается?

[Славян]

Да, сломается. Но:
это был очевидный пример только для проверки скорости. В реале я думал ставить символ с кодом 1. Если постараться, то лучше ставить, конечно, чистый нолик (код 0).

[Fr0sT]

Цитата Славян @ 05.02.19, 16:17

Вот исключительно эксперимента ради набросал свой StringReplace и получил:

Изощренец. PosEx и Copy(кусок до)+Copy(замена) решают задачу намного проще.