Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.142.197.212] |
|
Страницы: (3) 1 [2] 3 все ( Перейти к последнему сообщению ) |
Сообщ.
#16
,
|
|
|
Что-то я нисколько не вижу, где у вас идёт анализ ДО знака '='? Похоже, что вы просто все совпадения из второго списка ищете и убираете во всей строке.
Или как? |
Сообщ.
#17
,
|
|
|
Славян, Вот тут же анализ до и после знака "=".
В самой procedure Working: then _L1.Strings[i] := Format('%s=%s', [s, _L1.ValueFromIndex[i]]) else _L1.Strings[i] := Format('%s=%s', [_L1.Names[i], s]); |
Сообщ.
#18
,
|
|
|
Допускаю, что такие тормоза идут оттого, что строка 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 в новую строку, то должно получиться быстрее. Добавлено Цитата Kirilis2018 @ Не-не-не! Глядите:Вот тут же анализ до и после знака "=". В самой procedure Working: for j := 0 to _L2.Count - 1 do s := StringReplace(s, _L2.Strings[j], '', [rfReplaceAll]); |
Сообщ.
#19
,
|
|
|
Славян, Ух, теперь я точно запутался . И на этом спасибо, буду дальше думать.
|
Сообщ.
#20
,
|
|
|
Дело в том, что алгоритм не вполне корректный. Что бы удобней было понимать код и корректность алгоритмов - рекомендуется давать очевидные имена(имена с практической смысловой нагрузкой), к примеру вместо _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, о которых я упомянул ранее), и её же вызывать по необходимости. Добавлено Топикастер весьма далек от этой главы. |
Сообщ.
#21
,
|
|
|
Цитата Славян @ Действительно, Kirilis2018, гляньте на исходник её (RAD-XE8, System.AnsiString.PAS):Да и сам вызов StringReplace весьма тяжек, наверняка. 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; |
Сообщ.
#22
,
|
|
|
Славян, Руслан, Ребята - спасибо! Практически получилось, вот только, еще, некоторые моменты допилить - осталось!
|
Сообщ.
#23
,
|
|
|
Славян, ты, условно, пытаешься задвинуть школьнику про корпускулярно-волновой дуализм. Ни к чему ему это пока.
StringReplace в версиях 10+ допилили, теперь она не такая уж тупая при множественных заменах. Хотя все равно без нужды ее не стоит применять. А еще, честно говоря, я так и не понял, что ТС-у нужно. |
Сообщ.
#24
,
|
|
|
Цитата Славян @ SearchStr := S; // одно лишнее копирование ! в первом, втором и третьем "лишнем копировании" нету копирования тела строк. По сути тут один атомарный инкремент счетчика ссылок происходит. А вот NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt); // пятое ! SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt); // шестое ! действительно страшные строки. Но скорее всего тут ничего делать не будут ибо ансистринг только для легаси приложений оставлен. |
Сообщ.
#25
,
|
|
|
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; Добавлено Дальше оптимизировать нужно зная входные данные и пример того что ты пытаешься удалить из них |
Сообщ.
#26
,
|
|
|
^D^ima, Так отлично работает, да, намного быстрее. Спасибо!
|
Сообщ.
#27
,
|
|
|
Вот исключительно эксперимента ради набросал свой 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); |
Сообщ.
#28
,
|
|
|
Славян
А если в целевом тексте будет *, твой код сломается? |
Сообщ.
#29
,
|
|
|
Да, сломается. Но:
это был очевидный пример только для проверки скорости. В реале я думал ставить символ с кодом 1. Если постараться, то лучше ставить, конечно, чистый нолик (код 0). |
Сообщ.
#30
,
|
|
|
Цитата Славян @ Вот исключительно эксперимента ради набросал свой StringReplace и получил: Изощренец. PosEx и Copy(кусок до)+Copy(замена) решают задачу намного проще. |