Поиск объекта по параметрам в списке. - Общие вопросы Delphi

Человек_Борща · 03.02.2013, 17:23

Доброго времени суток!
Есть список объектов. В этом списке объектов я реализую такое:

Код:

function TCatalog.FindItem(const aFindData: TFindDataRec;
  var vCallback: TFindFoundCallBackProc): Boolean;
var
  i: Integer;
  Data: TCatalogItem;
begin
  Result := False;
  if not Assigned(vCallback) then
    Exit;
  for i := 0 to Count - 1 do
  begin
    Data := Items[i];

  end;
end;

TFindDataRec - список параметров на основе которых делается поиск, и там их 15.

Вопрос: Как искать, если параметры могут быть заданы не все а могут быть и все?
Подскажите методику организации поиска по большому кол-ву параметров. пожалуйста.

Problem resolved!

Код:

function TCatalog.FindItem(const aFindData: TFindDataRec;
  var vCallback: TFindFoundCallBackProc): Boolean;
var
  i, i2: Integer;
  Data: TCatalogItem;

  function TLStr(aStr: string): string;
  begin
    Result := LowerCase(Trim(aStr));
  end;

begin
  Result := False;
  if not Assigned(vCallback) then
    Exit;
  aFindData.FindCount := 0;
  for i := 0 to Count - 1 do
  begin
    Data := Items[i];
    if (aFindData.Genealogy <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.Genealogy), TLStr(Data.Genealogy)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.OwnerAddress <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.OwnerAddress), TLStr(Data.OwnerAddress)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.OwnerName <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.OwnerName), TLStr(Data.OwnerName)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.FirstOwner <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.FirstOwner), TLStr(Data.FirstOwner)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.Mother <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.Mother), TLStr(Data.Mother)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.Father <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.Father), TLStr(Data.Father)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.Mark <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.Mark), TLStr(Data.Mark)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.Nick <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.Mark), TLStr(Data.Nick)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.BreedId <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.BreedId), TLStr(Data.BreedId)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.ColorId <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.ColorId), TLStr(Data.ColorId)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.GenderId <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.GenderId), TLStr(Data.GenderId)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.ClassId <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.ClassId), TLStr(Data.ClassId)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.GroupId <> EmptyStr) then
    begin
      if (Pos(TLStr(aFindData.GroupId), TLStr(Data.GroupId)) > 0) then
        Inc(aFindData.FindCount);
    end;

    if (aFindData.BirthdayFrom <> EmptyStr) and
      (aFindData.BirthdayTo <> EmptyStr) then
    begin
      if (Data.Birthday >= StrToDate(aFindData.BirthdayFrom)) and
        (Data.Birthday <= StrToDate(aFindData.BirthdayTo)) then
      begin
        Inc(aFindData.FindCount);
      end;
    end;

    if aFindData.FindCount > 0 then
      vCallback(Self, Data);
  end;
end;

Slym · 03.02.2013, 19:39

это копец... время выполнения ужос... LoCase/проверка на каждой итерации...
if aFindData.FindCount > 0 then vCallback(Self, Data);
совпадение одного атрибута приведет к вызову калбека, а должно всех

кроме того после первого совпадения салбек сработает для остальных т.к. нет очистки aFindData.FindCount := 0;

Человек_Борща · 03.02.2013, 19:46

Цитата:

совпадение одного атрибута приведет к вызову калбека, а должно всех

в этом и прикол, что юзер определяет по каким параметрам искать.

Цитата:

кроме того после первого совпадения салбек сработает для остальных т.к. нет очистки aFindData.FindCount := 0;

Тут спасибо не заметил.

Аватар · 03.02.2013, 20:12

Параметры по которым искать можно через множество задать

Код:

type TMyParam1 = (myParm1,myParm2,...,myParmN);
     TMyParams = set of TMyParam1;

var xMyParams: TMyParams;

  xMyParams:=[myParm1,myParm3];

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

Код:

if (not (myParm1 in xMyParams) or сравнение1) and
   (not (myParm2 in xMyParams) or сравнение2) and
   ...
   (not (myParmN in xMyParams) or сравнениеN) найдено

Slym · 03.02.2013, 20:16

мой вариант

Код:

function TCatalog.FindItem(const aFindData: TFindDataRec;
  var vCallback: TFindFoundCallBackProc): Boolean;
var
  i, IndexedAttrib: Integer;
  Index:array of byte;
  LString:string;

  function TLStr(const aStr: string): string;
  begin
    Result := LowerCase(Trim(aStr));
  end;

begin
  Result := False;
  if not Assigned(vCallback) then
    Exit;
  SetLength(Index,Count);
  for i:=0 to Length(Index)-1 do
    Index[i]:=0;
  IndexedAttrib:=0;

  if (aFindData.Genealogy <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.Genealogy);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).Genealogy)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.OwnerAddress <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.OwnerAddress);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).OwnerAddress)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.OwnerName <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.OwnerName);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).OwnerName)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.FirstOwner <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.FirstOwner);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).FirstOwner)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.Mother <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.Mother);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).Mother)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.Father <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.Father);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).Father)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.Mark <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.Mark);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).Mark)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.Nick <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.Nick);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).Nick)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.BreedId <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.BreedId);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).BreedId)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.ColorId <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.ColorId);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).ColorId)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.GenderId <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.GenderId);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).GenderId)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.ClassId <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.ClassId);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).ClassId)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.GroupId <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    LString:=TLStr(aFindData.GroupId);
    for i := 0 to Count - 1 do
      if (Pos(LString, TLStr(TCatalogItem(Items[i]).GroupId)) > 0) then Inc(Index[i]);
  end;
  if (aFindData.BirthdayFrom <> EmptyStr) and
    (aFindData.BirthdayTo <> EmptyStr) then
  begin
    inc(IndexedAttrib);
    for i := 0 to Count - 1 do
      if (TCatalogItem(Items[i]).Birthday >= StrToDate(aFindData.BirthdayFrom)) and
        (TCatalogItem(Items[i]).Birthday <= StrToDate(aFindData.BirthdayTo)) then
         Inc(Index[i]);
  end;
  if IndexedAttrib>0 then
    for i := 0 to Count - 1 do
      if Index[i]=IndexedAttrib then
        vCallback(Self, TCatalogItem(Items[i]));
  result:=true;
end;

StrToDate - тоже желательно за цикл вынести

Человек_Борща · 03.02.2013, 20:55

Цитата:

StrToDate - тоже желательно за цикл вынести

Не возможно. Я просто сделал 2е поле даты но уже как строки.

Код:

т.к. нет очистки aFindData.FindCount := 0;

Обнуляю в начале цикла.

Slym, не понятно зачем, вся эта пивоварня с массивом?
Считчиком найденного является aFindData.FindCount, который я обнуляю в начале цикла, чтобы следующий элемент ненароком не попал в список найденного.

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

Slym · 03.02.2013, 21:08

Цитата:

Сообщение от Человек_Борща

Slym, не понятно зачем, вся эта пивоварня с массивом?
Считчиком найденного является aFindData.FindCount, который я обнуляю в начале цикла, чтобы следующий элемент ненароком не попал в список найденного.

в моем примере найденной считается строка совпадающая со всеми ненулевыми критериями
(в вашем с любым не нулевым критерием)
массив первую очередь избавляет от постоянной проверки критерия if (aFindData.Критерий <> EmptyStr) then
компромис экономии ЦПУ в сторону увеличения памяти

можно ускорится еще так

Код:

if (aFindData.OwnerAddress <> EmptyStr) then
  begin
    LString:=TLStr(aFindData.OwnerAddress);
    for i := 0 to Count - 1 do
      if Index[i]=IndexedAttrib then
        if (Pos(LString, TLStr(TCatalogItem(Items[i]).OwnerAddress)) > 0) then Inc(Index[i]);
    inc(IndexedAttrib);
  end;

т.е. делать строковое сравнение строки в случае если строка прошла все предыдущие проверки
иначе даже не пробовать сравнивать

а вообще тестируй свой и мой варианты загоняя все в тиккаунты... смотри результат и делай выводы

Sibedir · 03.02.2013, 21:21

Цитата:

Сообщение от Аватар

Параметры по которым искать можно через множество задать

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

Напротив строки (edit'а) ввода параметра поиска поставь галочку [использовать/не использовать] данный параметр поиска. В процедуру поиска добавь

Код:

function TCatalog.FindItem(const aFindData: TFindDataRec;
  Params: TMyParams;
  var vCallback: TFindFoundCallBackProc): Boolean;

и используй структуру Аватар'а.
1. Возрастет производительность поиска
2. Как по мне (далее сугубо субъективно), код станет более компактным и понятным.

Slym · 03.02.2013, 21:29

можно вместо множества проиндексировать поля рекордов например так
тогда можно перебирать атрибуты в цикле а не инлайнить

Код:

type
  TFindDataRec=packed record
    Genealogy,OwnerAddress,OwnerName,FirstOwner,Mother,Father,Mark:string;
  end;
  TAttribRec=(arGenealogy,arOwnerAddress,arOwnerName,arFirstOwner,arMother,arFather,arMark);
  TFindDataArray=packed array[TAttribRec] of string;

procedure TForm1.Button1Click(Sender: TObject);
var
  FindDataRec:TFindDataRec;
  i:TAttribRec;
begin
  for i:=arGenealogy to arMark do
    TFindDataArray(FindDataRec)[i]:=IntToStr(Ord(i));
  Memo1.Lines.Add(FindDataRec.Genealogy);
  Memo1.Lines.Add(FindDataRec.OwnerAddress);
  Memo1.Lines.Add(FindDataRec.OwnerName);
  Memo1.Lines.Add(FindDataRec.FirstOwner);
  Memo1.Lines.Add(FindDataRec.Mother);
  Memo1.Lines.Add(FindDataRec.Father);
  Memo1.Lines.Add(FindDataRec.Mark);
end;

осталось также проиндексировать TCatalogItem, но не могу предположить структуру и получим коротко (псевдокод)

Код:

  for i := 0 to Count - 1 do
    for j:=arGenealogy to arMark do
    begin
      if TFindDataArray(aFindData)[j]<> EmptyStr then
        if (Pos(TFindDataArray(aFindData)[j], TLStr(TCatalogItemArray(Items[i])[j])) > 0) then ...............
    end;

Аватар · 03.02.2013, 21:47

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

Код:

  for i:=0 to Count-1 do begin
    Data:=Items[i];
    if (not (myParm1 in xMyParams) or (Pos(TLStr(aFindData.Genealogy), TLStr(Data.Genealogy)) > 0)) and
       (not (myParm2 in xMyParams) or (Pos(TLStr(aFindData.OwnerAddress), TLStr(Data.OwnerAddress)) > 0)) and
       (not (myParm3 in xMyParams) or (Pos(TLStr(aFindData.OwnerName), TLStr(Data.OwnerName)) > 0)) and
       (not (myParm4 in xMyParams) or (Pos(TLStr(aFindData.FirstOwner), TLStr(Data.FirstOwner)) > 0)) and
       (not (myParm5 in xMyParams) or (Pos(TLStr(aFindData.Mother), TLStr(Data.Mother)) > 0)) and
       (not (myParm6 in xMyParams) or (Pos(TLStr(aFindData.Father), TLStr(Data.Father)) > 0)) and
       (not (myParm7 in xMyParams) or (Pos(TLStr(aFindData.Mark), TLStr(Data.Mark)) > 0)) and
       (not (myParm8 in xMyParams) or (Pos(TLStr(aFindData.Mark), TLStr(Data.Nick)) > 0)) and
       (not (myParm9 in xMyParams) or (Pos(TLStr(aFindData.BreedId), TLStr(Data.BreedId)) > 0)) and
       (not (myParmA in xMyParams) or (Pos(TLStr(aFindData.ColorId), TLStr(Data.ColorId)) > 0)) and
       (not (myParmB in xMyParams) or (Pos(TLStr(aFindData.GenderId), TLStr(Data.GenderId)) > 0)) and
       (not (myParmC in xMyParams) or (Pos(TLStr(aFindData.ClassId), TLStr(Data.ClassId)) > 0)) and
       (not (myParmD in xMyParams) or (Pos(TLStr(aFindData.GroupId), TLStr(Data.GroupId)) > 0)) and
       (not (myParmE in xMyParams) or ((Data.Birthday >= StrToDate(aFindData.BirthdayFrom)) and (Data.Birthday <= StrToDate(aFindData.BirthdayTo))))
    then vCallback(Self, Data);
  end;

03.02.2013, 19:39	#2
Slym Участник клуба Регистрация: 07.12.2011 Сообщений: 1,025	это копец... время выполнения ужос... LoCase/проверка на каждой итерации... if aFindData.FindCount > 0 then vCallback(Self, Data); совпадение одного атрибута приведет к вызову калбека, а должно всех кроме того после первого совпадения салбек сработает для остальных т.к. нет очистки aFindData.FindCount := 0; Не стесняемся, плюсуем! Последний раз редактировалось Slym; 03.02.2013 в 20:16.

03.02.2013, 20:12	#4
Аватар Старожил Регистрация: 17.11.2010 Сообщений: 18,922	Параметры по которым искать можно через множество задать Код: `type TMyParam1 = (myParm1,myParm2,...,myParmN); TMyParams = set of TMyParam1; var xMyParams: TMyParams; xMyParams:=[myParm1,myParm3];` Искать в соответствии с теми параметрами, что задал юзер и только по ним типа Код: `if (not (myParm1 in xMyParams) or сравнение1) and (not (myParm2 in xMyParams) or сравнение2) and ... (not (myParmN in xMyParams) or сравнениеN) найдено` Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Поиск по 3 параметрам	Айдар	БД в Delphi	8	03.12.2012 22:01
Поиск по параметрам	amosik	Microsoft Office Access	1	20.05.2012 01:01
поиск в списке	sergo2705	Microsoft Office Access	1	16.08.2011 16:20
Поиск файлов формата bmp по заданным параметрам	LinaSh	Помощь студентам	17	18.04.2011 21:08
Автоматический поиск ячейки по заданным параметрам	Renzo	Microsoft Office Excel	5	07.03.2009 17:48