Фильтр по шаблону

[pupsik]

50000000 и символов больше. Заморочился с оптимизациями этими, в итоге разница была смехотворная.

не понял. Вы работали с большим объёмом данных. попытались оптимизировать. И разница не большая? Может что то не так делали?

[resident]

я просто не догоняю как кармически правильно реализовать указатель на текущий символ

Это ж элемент массива [i] - номер байта. Ваши скобки "<>" из исконной ASCII, т.е. кодируются одним байтом всегда

[Лекс Айрин]

Это провокация

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

Добавлено спустя 1 минуту 34 секунды:

Это ж элемент массива [i] - номер байта. Ваши скобки "<>" из исконной ASCII, т.е. кодируются одним байтом всегда

я уже начинаю к этому подходить. и придется переделать код в трех местах.

[resident]

Добавил третью версию функции. Я кстати с начала удивился, зачем здесь циклы. А они здесь и не нужны, ИМХО.

Код: Выделить всё

program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  { you can add units after this }
  SysUtils;

Type
  OnOff=boolean;
  TTag=record
    Str:String;
   // verify:OnOff;
    tags:boolean;
  end;

function FirstTag (var Str:String):TTag;
Var
   Start, Finish:boolean;
   StrTag:String;
Begin
     If Str='' then
      begin
        Result.Str:='';//отсев ошибочного использования
      end else
      begin
           Start:=False;  // инициализация переменных.
           Finish:=False;
           Result.Str:='';
           Result.tags:=true;
           StrTag:='';

           while Finish=false do   //
           begin
           if Str='' then
             Begin
                  Finish:=True;//выход из цикла по исчерпанию строки. условия выхода могут быть любые
                  Result.tags:=false;
             End else

             Begin
                  StrTag:=Copy(Str,1,1);
                  case  StrTag of
                    '<':
                      Begin
                      if Start=true then
                        Begin  //это второй символ '<'
                          Finish:=True; // штатный выход если это все же не тег.
                          Result.tags:=false;

                        end else  //это первый символ '<'.
                        begin   // начинаем копировать предположительно тег в строку

                            if  Result.Str='' then
                              begin
                                    Start:=True;
                                    Result.Str:=Result.Str+StrTag;
                                    Delete(Str, 1, 1);
                              end else
                            begin  // результат  -- все, что до символа '<' НЕ тег
                                   Finish:=True;
                                   result.tags:=false;

                            end;

                        end

                      end;
                    '>':
                      Begin
                           Result.Str:=Result.Str+StrTag;
                           Delete(Str, 1, 1);

                           if Start=true then
                             begin
                               Finish:=True;// штатный выход если тег

                               result.tags:=true;
                             end else
                             begin
                                Finish:=True;// штатный выход если НЕ тег
                                result.tags:=false;
                             end;

                      end;
                  else Begin
                            Result.Str:=Result.Str+StrTag; // обычный символ
                            Delete (Str, 1, 1);

                       End;
                  end;
             end;
           end;
      end;
end;


function FirstTag2 (const Str:String):TTag;
var
  i, k, L: integer;
begin
  i := 0;
  L := Length(Str);
  repeat
    Inc(i);
    if Str[i] = '<' then
      begin
        k := i;
        repeat
          Inc(k);
          if Str[k] = '>' then
            begin
              Result.Str := Copy(Str, Succ(i), Pred(k - i));
              Result.tags := Length(Result.Str) > 0;
              exit;
            end;
        until k = L;
      end;
  until i = L;

  Result.Str := '';
  Result.tags := false;
end;


function FirstTag3 (const Str:String):TTag;
var
  i, k: integer;
  S: string;
begin
  Result.Str := '';

  i := Pos('<', Str);
  if i > 0 then
    begin
      S := pChar(@Str[i]);
      k := Pos('>', S);
      if k > 0 then Result.Str := Copy(S, Succ(1), Pred(Pred(k)));
    end;

  Result.tags := Length(Result.Str) > 0;
end;

{function TestTag (Str:TTag):Boolean;
Var
  TempStr:string;

Begin
    TempStr:=Copy(Str.Str,0,4);//больше 4 вряд ли потребуется

{
теги после которых строка переводится:
<bp> </h1 <h2 <h3 </p> </di </ta </tr </th </tb </li
во всех остальных случаях нет!}
    //showMessage ('function TestTag -- TempStr='+TempStr);
    case TempStr   of
      '<bp>', '</h1', '<h2', '<h3', '</p>', '</di', '</ta', '</tr', '</th', '</tb', '</li'
      :begin
        result:=true;
       end;}

function BoolToStr(B: boolean): string;
  begin
    if B then
      Result := 'true' else
      Result := 'false';
  end;

Var
  TempStr:string;


begin
  writeln('*****************************************' + sLineBreak + 'TempStr');
  TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);

  writeln('*****************************************' + sLineBreak + sLineBreak + sLineBreak + 'TempStr2');

  TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);

  TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);

  TempStr := 'first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);

  TempStr := '_12<firstasdasd<dasdas<qweqweasdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);

  TempStr := '_12first>asdasddasdas>qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);


  writeln('*****************************************' + sLineBreak + sLineBreak + sLineBreak + 'TempStr3');

  TempStr := 'firstasdasddasdasqweqweasdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := '<first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := '<>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := '_12<>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := 'first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := '_12<firstasdasd<dasdas<qweqweasdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  TempStr := '_12first>asdasddasdas>qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag3(TempStr).tags) + ': ' + FirstTag3(TempStr).Str);

  readln;
end.


[Лекс Айрин]

Да, именно третью версию я, пожалуй, и "конфискую". правда, немного покурю что и как...

Добавлено спустя 11 минут 31 секунду:
упс... вы поменяли логику работы функции моя то отрезала от начала либо тег, либо не тег до ближайшего символа'<', при необходимости testTag указывала стоит ли переводить строку.

Добавлено спустя 36 минут 18 секунд:
например, вот это ошибка алгоритма -- не учитывается, что угловая скобка может быть частью строки, но не может быть составной частью тега.

Код: Выделить всё

_12<fi<rst>asdasd<dasdas><qweqwe>asdasd
true: fi<rst



должно быть "rst"

ЗЫ: но направление я понял.

[resident]

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

Тогда похоже без циклов не обойтись.

Добавлено спустя 7 минут 32 секунды:
Ок

[Лекс Айрин]

не факт. Буду думать.

[resident]

Во второй остался один цикл, не знаю, как избавится от него

Код: Выделить всё

function FirstTag2 (const Str:String):TTag;
var
  i, k, m, L: integer;
  S: string;
begin
  Result.Str := '';
  Result.tags := false;

  L := Length(Str);
  i := Pos('<', Str);
  if i > 0 then
    begin
      k := i;
      repeat
        Inc(k);
        if Str[k] = '<' then i := k; // Сначала строки - мусор, среди которого были и открывающиеся скобки. Принимаю новую позицию открывающейся скобки
        if Str[k] = '>' then // Целый тег найден
          begin
            if i = 1 then
              // Строка начинается с тега - копирую содержимое элемента между тегами
              begin
                S := pChar(@Str[Succ(i)]);
                i := Pos('>', S);
                k := Pos('<', S);
                Result.Str := Copy(S, Succ(i), Pred(k - i));
                Result.tags := Length(Result.Str) > 0;
              end else
              // Строка начинается с мусора - копирую имя тега
              begin
                Result.Str := Copy(Str, Succ(i), Pred(k - i));
              end;
            exit;
          end;
      until k = L;
    end;
end;   

Добавлено спустя 16 минут 30 секунд:
Ваша вроде тоже не безупречна. См. скрин. Похоже нужно каждую ситуацию прорабатывать. Хотя как тут угадать, что там будет.
Для примера, EmEditor, которым я пользуюсь. Если в содержимом элемента по сути указано название товара, а в названии аля "Kremlin is Putin's house"есть апостроф, то он до следующего весь файл подсвечивает комментарием.

[Лекс Айрин]

resident, важно понимать для чего делается та или иная процедура функция. если бы мне просто надо было удалить теги, то это было бы просто -- найденная строка просто бы обнулялась. Но мне еще надо учитывать, что тег может заканчивать абзац. а это уже другая история. То есть, либо динамически проходить по строке, если надо добавляя символы перевода строки, либо сохранять позицию строк и в процессе удаления (по сохраненным позициям) проверять наличие нужных тегов.

фактически в выхлопе может быть пустая строка (не должна, но не будем исключать), строка до первого тега, обычный тег и тег переводящий строку.
вариант когда в строке первым встречается '>' относим к строке без тегов и сразу отправляем в выхлоп, помечая, что это НЕ тег.
вариант когда после '<' такой же символ -- аналогично.
вариант когда позиция символов '<' и '>' одинакова это пустая строка -- почему домашнее задание и, естественно, это тоже НЕ тег.
итого, крайний вариант когда '>' следует после '<' . Это полноценный (псевдо) тег.

Если пытаться найти конкретно первый тег, то да, придется вводить счетчики символов и прочие усложнения, но это и не нужно. Видимо, смутило название функции.

Добавлено спустя 1 минуту 49 секунд:
ах да.. есть еще вариант когда символ '<' не встречается совсем -- то есть тегов нет.

Добавлено спустя 3 минуты 38 секунд:

Ваша вроде тоже не безупречна.

странно... все работало нормально.

[resident]

Ок

[pupsik]

Лекс Айрин как я понимаю: Есть текст. В нем начинающий тег < и завершающий тег >. Внутри может быть что угодно. Вот это "угодно" вам и необходимо вытащить?

[Лекс Айрин]

pupsik не вытащить. Удалить. Но задача делится на 2 этапа. вначале я режу по символам '<' и '>', проверяю тег или нет, а уже в другом месте (не выложенном) я решаю удалить или нет подстроку. И стоит ли разделить строку по этому месту на две. И да... само содержимое тега важно только из-за возможного перевода строк.

[pupsik]

Т.е. единственное вам необходимое - перевод строки внутри тегов. Остальное - удаляется?

[Лекс Айрин]

pupsik, не внутри тега, а вместо него. Это просто, по возможности, импорт текста из html/xml формата.
ЗЫ: задача решена, но увы не самым оптимальным образом. На что мне и указали.

[pupsik]

Т.е. есть < Lineend > необходимо сделать lineend?

импорт текста из html/xml формата

- хтмл... там же много мусора. Или вам и мусор необходим?