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

[Лекс Айрин]

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

оно часто так. На самом деле, лично над этим кодом я бился долго. В том числе и меняя реализацию. Это, кстати, заметно по закомментированому полю в TTag, которое просто не понадобилось в окончательной редакции.

[AlphaBlend]

eoleg очень интересную тему подкинули ))

Добавлено спустя 6 минут 3 секунды:
Лекс Айрин мне кажется , что чем задача проще с первого взгляда - тем сложнее она в решении ) Казалось бы - чего стоит строчку отфильтровать ? ) А вон сколько всего надо ) Кстати если попробовать создать класс для поиска по шаблонам номеров телефонов , счетов , каких-то еще строк с числами , разделенными символами - он будет очень полезен ) Задалась такой целью , изучаю поглубже Или создать TEdit с новыми свойствами и методами ) Такой расширенный )

[eoleg]

Я тут еще рылся немного, народ с помощью regexp делает
http://regexpstudio.com/RU/
http://iantonov.me/page/reguljarnye-vyr ... a-v-delphi
у меня файл на 40000 строк, ну и нужно самый легкий алгоритм выбрать.

[AlphaBlend]

eoleg Используйте обязательно потоки ) Иначе программа может "подвиснуть" ) а регулярные выражения если , то Вам проще обратиться к их прородителю - Perl )

[Лекс Айрин]

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

кстати, для четко определенных шаблонов раньше было бы проще рассматривать строку как массив байтов. Сейчас увы нет((( Но никто не запрещает проверять конкретные позиции в строке.

Или создать TEdit с новыми свойствами и методами )

тогда уж не TEdit, а их набор с автоматическим переходом между ними. А разделяемые символы вставлять/убирать при присваивании. Кстати, проверка тогда проще -- ведь мы точно знаем сколько символов откусить и какие подстановочные.

[AlphaBlend]

Лекс Айрин property TemplateMask .... TTemplateMask = ( tmMoney , tmDateTime, tmCard, tmPrice, tmNone ) ...

тогда уж не TEdit, а их набор с автоматическим переходом между ними

в смысле (Component as TEditMoney) или (Component as TEditCard) ? ) примерно так ? )

[Лекс Айрин]

в смысле (Component as TEditMoney) или (Component as TEditCard) ? ) примерно так ? )

возможно.... но и ручная реализация не сильно сложна

пока вот такая вот реализация )))

это как надо ВАМ. И потом, добавить новый функционал всегда можно.

[AlphaBlend]

Лекс Айрин когда он начнет хоть как-то работать - я исходник выложу и вы как профессионалы посмотрите ))) Ценный совет всегда ценится )

[Лекс Айрин]

AlphaBlend, я НЕ профессионал. Я вообще фантаст-графоман. Хотя посмотреть можно будет, почему бы и нет.

[AlphaBlend]

Лекс Айрин ахах ))) Лазарус всех в кучу собирает ) писателей , домохозяек , ученых, студентов ) Нет равных перед его мощью и простотой )

[Лекс Айрин]

это да. Просто понадобился блокнот заточенный под себя любимого. Ну и с универа остались навыки программирования в паскале.

[pupsik]

Интересно: а такой вариант подойдет?

п.с.
ютф8 - зло? Или я не умею его готовить?

[alexs]

Безусловно. Я лишь привел пример. Насчет оптимизации я бы послушал внимательно...

В данном коде я бы не стал использовать столь массово копирование строк. Сначала бы индексами отсекал нужные участки строк, а копирование строк делал бы уже после определния нужной последовательности. Просто работа со строками в данном участке кода будет занимать наибольшее время.

[Лекс Айрин]

alexs, понятно. но подобное усложнение алгоритма я пока не потяну -- я просто не догоняю как кармически правильно реализовать указатель на текущий символ. чисто как интегер?

И, как я понимаю, мне придется использовать массив вырезаемых участков?

Добавлено спустя 10 минут 31 секунду:
хотя присмотрелся внимательней... изменения не сильно большие... попробую переделать уменьшив работу по копированию строк.

[resident]

Представьте , когда проверяемых строк будет десять тысяч , а символов в строке - 255 ? )

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

Конечно , при таких объемах необходимо использовать потоки , но все же )

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

Application.ProcessMessages;

Через каждую тыщу, и не нужны никакие потоки.

Надо учитывать разную аппаратную конфигурацию ) Может программа будет где-нибудь на мало-мальски работающем компьютере , который еле-еле удовлетворяет требованиям XP ?)

Кстати да, надо бы встроить ограничитель на операционную систему. Владельцы XP пусть сами мучаются, это их проблемы. Но чтоб на будущих ОС не запускалась.

Добавлено спустя 1 час 9 минут 56 секунд:

Насчет оптимизации я бы послушал внимательно...

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

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

program project1;

{$mode objfpc}{$H+}

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

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 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('TempStr');
  TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
  writeln(sLineBreak + TempStr);
  writeln(BoolToStr(FirstTag(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);

  writeln(sLineBreak + sLineBreak + 'TempStr2');

  TempStr := '<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);

  readln;
end.


Добавлено спустя 2 минуты 26 секунд:
Кстати, почему-то у вас выдает .tags = false.