mORMot Open Source

dorival

Member

From: Brasil

Registered: 2013-04-17

Posts: 35

alternative to find a record with multiples fields

Hello,

I need to find a record with more than one field.
How can I implement this?

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 13,187

Website

Re: alternative to find a record with multiples fields

There is no direct multi-field search built-in.

You can do a map/reduce algorithm.

You should first search any indexed field, then check if it matches the other fields expected values...

dorival

Member

From: Brasil

Registered: 2013-04-17

Posts: 35

Re: alternative to find a record with multiples fields

ok, thanks.

dorival

Member

From: Brasil

Registered: 2013-04-17

Posts: 35

Re: alternative to find a record with multiples fields

I need a generic function. About code below, any suggestions / critique?

function TBigTableTemporary.FindKey(ATable: TSynBigTableRecord; const Field: array of String; const KeyWord: array of variant): boolean;
var
  FieldSearch: TSynTableFieldProperties;
  i, indexOfArray: smallint;
  IndexSearch: array of TIntegerDynArray;
  actualIndex: integer;

  function MatchInt(const AInt: Integer; const AValues: TIntegerDynArray): boolean;
  var
    i: Integer;
  begin
    Result := false;
    for I := Low(AValues) to High(AValues) do
      if (AInt = AValues[i]) then
      begin
        Result := true;
        Break;
      end;
  end;

begin
  setLength(IndexSearch,high(Field)+1);
  for i:=0 to high(Field) do
  begin
    FieldSearch := ATable.Table[Field[i]];
    if Assigned(FieldSearch) then
    begin
      actualIndex := 0;
      IDCount := 0;
      ATable.search(FieldSearch,FieldSearch.SBf(Keyword[i]),IndexSearch[i],IDCount);
      result := IDCount > 0;
    end;
    {else maybe raise...}
  end;
  IndexFounds := 0;
  setlength(IndexFounds, 254);
  indexOfArray:= 0;
  actualIndex := 0;
  for i:=0 to high(Field) do
  begin
    actualIndex := 0;
    while (IndexSearch[i, actualIndex]>0) do
    begin
      if MatchInt(IndexSearch[i,actualIndex], IndexSearch[i+1]) then
      begin
        IndexFounds[indexOfArray] := IndexSearch[i,actualIndex];
        inc(indexOfArray);
      end;
      inc(actualIndex);
    end;
  end;
  result := actualIndex > 0;
end;

dorival

Member

From: Brasil

Registered: 2013-04-17

Posts: 35

Re: alternative to find a record with multiples fields

a new version... ignore the last...

function TBigTableTemporary.FindKey(Table: TSynBigTableRecord; const Field: array of String; const KeyWord: array of variant): boolean;
var
  FieldSearch: array of TSynTableFieldProperties;
  DataTable: TSynTableData;
  i, y: integer;
  indexField: integer;
begin
  result := false;

  setLength(FieldSearch,high(Field)+1);
  IndiceAtual := 0;
  IDCount := 0;

  FieldSearch[0] := Table.Table[Field[0]];
  if not(Assigned(FieldSearch[0])) then
    raise exception.create('Field '+Field[0]+' not found');

  // First, find de first index...
  Table.search(FieldSearch[0],FieldSearch[0].SBf(Keyword[0]),IndexesFounds,IDCount);

  if IDCount = 0 then
    exit;

  // then, the others fields....
  for indexField:=1 to high(Field) do
  begin
    FieldSearch[indexField] := Table.Table[Field[indexField]];
    if not(Assigned(FieldSearch[0])) then
      raise exception.create('Field '+Field[indexField]+' not found');

    i := 0;
    while (i < IDCount) do
    begin
      Table.RecordGet(IndexesFounds[i], DataTable);

      while (DataTable.GetFieldValue(FieldSearch[indexField]) <> KeyWord[indexField]) do
      begin
        for y:=i to pred(IDCount) do
          if not(y>high(IndexesFounds)) then
            IndexesFounds[y] := IndexesFounds[y+1];

        dec(IDCount);
        if (IDCount = 0) or (i > pred(IDCount)) then
          break;

        Table.RecordGet(IndexesFounds[i], DataTable);
      end;
      inc(i);
    end;
  end;

  result := IDCount > 0;
end;

dorival

Member

From: Brasil

Registered: 2013-04-17

Posts: 35

Re: alternative to find a record with multiples fields

with de examples I did this...
It's a base class
(sorry, some names of functions and variables are in portuguese)

unit Lib.BigTableTemporary;

interface

uses
  SynBigTable, SynCommons, StrUtils;

type

  TBigTableTemporary = class(TInterfacedObject)
  protected
    Tabela: TSynBigTableRecord;
    Registro: TSynTableData;
    IDCount: integer;
    IndexesFounds: TIntegerDynArray;
    IndiceAtual: integer;
    NomeArquivo: string;
    procedure SetarRegistro;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    function FindAllAndFirst: boolean;
    procedure Insert;
    procedure Next;
    function EOF: boolean;
    procedure Save;
    procedure SaveFile;
    procedure Delete(AID: integer); virtual;
    function Count: integer;

    function FindKey(const Field: array of String; const KeyWord: array of variant): boolean; overload;
    function FindKey(const Field: String; const KeyWord: variant): boolean; overload; 
  end;


implementation

uses
  SysUtils;

{ TBigTableBlocoPIndicador }

function TBigTableTemporary.Count: integer;
begin
  result := Tabela.Count;
end;



constructor TBigTableTemporary.Create;

  function GetFileName: string;
  begin
    result := 'BigTable' + FormatDateTime('yyyymmddhhmmsszzz', now) + '.tmp';
  end;
  
begin
  NomeArquivo := GetFileName;
  while FileExists(NomeArquivo) do
    NomeArquivo := GetFileName;

  Tabela := TSynBigTableRecord.Create(NomeArquivo,'tabela');
end;



procedure TBigTableTemporary.Delete(AID: integer);
begin
  Tabela.delete(AID);
end;



destructor TBigTableTemporary.Destroy;
begin
  FreeAndNil(Tabela);
  DeleteFile(NomeArquivo);
  inherited;
end;



function TBigTableTemporary.EOF: boolean;
begin
  result := IndiceAtual+1 > IDCount;
end;



function TBigTableTemporary.FindKey(const Field: String; const KeyWord: variant): boolean;
var
  FieldSearch: TSynTableFieldProperties;
begin
  IndiceAtual := 0;
  IDCount := 0;
  FieldSearch := Tabela.Table[Field];
  Tabela.search(FieldSearch,FieldSearch.SBf(Keyword),IndexesFounds,IDCount);
  result := IDCount > 0;
end;



function TBigTableTemporary.FindKey(const Field: array of String; const KeyWord: array of variant): boolean;
var
  FieldSearch: array of TSynTableFieldProperties;
  DataTable: TSynTableData;
  i, y: integer;
  indexField: integer;
begin
  result := false;

  setLength(FieldSearch,high(Field)+1);
  IndiceAtual := 0;
  IDCount := 0;

  FieldSearch[0] := Tabela.Table[Field[0]];
  if not(Assigned(FieldSearch[0])) then
    raise exception.create('Field '+Field[0]+' not found');

  Tabela.search(FieldSearch[0],FieldSearch[0].SBf(Keyword[0]),IndexesFounds,IDCount);

  if IDCount = 0 then
    exit;

  // a partir do segundo campo...
  for indexField:=1 to high(Field) do
  begin
    FieldSearch[indexField] := Tabela.Table[Field[indexField]];
    if not(Assigned(FieldSearch[0])) then
      raise exception.create('Field '+Field[indexField]+' not found');

    // percorre todos os indices encontrados (0 até count)...
    i := 0;
    while (i < IDCount) do
    begin
      // pega o registro
      Tabela.RecordGet(IndexesFounds[i], DataTable);

      // enquanto o campo do registro é diferente do parametro enviado...
      while (DataTable.GetFieldValue(FieldSearch[indexField]) <> KeyWord[indexField]) do
      begin
        // decrementa dados do array de indices...
        for y:=i to pred(IDCount) do
          if not(y>high(IndexesFounds)) then
            IndexesFounds[y] := IndexesFounds[y+1];

        // decrementa um do contador
        dec(IDCount);
        if (IDCount = 0) or (i > pred(IDCount)) then
          break;

        // carrega novamente os dados para o while
        Tabela.RecordGet(IndexesFounds[i], DataTable);
      end;
      inc(i);
    end;
  end;

  result := IDCount > 0;
end;



function TBigTableTemporary.FindAllAndFirst: boolean;
begin
  IndiceAtual := 0;
  IDCount := Tabela.GetAllIDs(IndexesFounds);
  result := IDCount > 0;
end;




procedure TBigTableTemporary.Insert;
begin
  Registro.Init(Tabela.Table);
end;



procedure TBigTableTemporary.Next;
begin
  inc(IndiceAtual);
end;



procedure TBigTableTemporary.Save;
begin
  if Tabela.RecordAdd(Registro) = 0 then
    Tabela.RecordUpdate(Registro);
  if (Tabela.Count mod 1000000) = 0 then
    SaveFile;
end;



procedure TBigTableTemporary.SaveFile;
begin
  Tabela.UpdateToFile;
end;



procedure TBigTableTemporary.SetarRegistro;
begin
  if Registro.ID <> IndexesFounds[IndiceAtual] then
    Registro := Tabela.RecordGet(IndexesFounds[IndiceAtual]);
end;



end.

... and a use like this...

unit uTabelaTemp;

interface

uses
  Lib.BigTableTemporary, SynCommons;

type

  TTabela = class(TBigTableTemporary)
  private
    FIndicador: TSynTableFieldProperties;
    FDataInicial: TSynTableFieldProperties;
    FDataFinal: TSynTableFieldProperties;
    FValorReceitaBruta: TSynTableFieldProperties;
    FValorReceitaBrutaTributada: TSynTableFieldProperties;
    FAliquotaTributo: TSynTableFieldProperties;
    FValorTributo: TSynTableFieldProperties;

    function GetIndicador: integer;
    function GetDataInicial: TDateTime;
    function GetDataFinal: TDateTime;
    function GetValorReceitaBruta: currency;
    function GetValorReceitaBrutaTributada: currency;
    function GetAliquotaTributo: currency;
    function GetValorTributo: currency;

    procedure SetIndicador(const Value: integer);
    procedure SetDataInicial(const Value: TDateTime);
    procedure SetDataFinal(const Value: TDateTime);
    procedure SetValorReceitaBruta(const Value: currency);
    procedure SetValorReceitaBrutaTributada(const Value: currency);
    procedure SetAliquotaTributo(const Value: currency);
    procedure SetValorTributo(const Value: currency);

  public
    property Indicador: integer read GetIndicador write SetIndicador;
    property DataInicial: TDateTime read GetDataInicial write SetDataInicial;
    property DataFinal: TDateTime read GetDataFinal write SetDataFinal;
    property ValorReceitaBruta: currency read GetValorReceitaBruta write SetValorReceitaBruta;
    property ValorReceitaBrutaTributada: currency read GetValorReceitaBrutaTributada write SetValorReceitaBrutaTributada;
    property AliquotaTributo: currency read GetAliquotaTributo write SetAliquotaTributo;
    property ValorTributo: currency read GetValorTributo write SetValorTributo;

    constructor Create;

  end;


implementation

uses
  SysUtils;



{implementation of TRegistroP100}





constructor TTabela.Create;
begin
  inherited;

  Tabela.AddField('Indicador',tftInt32,[tfoIndex,tfoUnique]);
  Tabela.AddField('DataInicial',tftDouble,[tfoIndex]);
  Tabela.AddField('DataFinal',tftDouble,[tfoIndex]);
  Tabela.AddField('ValorReceitaBruta',tftCurrency,[]);
  Tabela.AddField('ValorReceitaBrutaTributada',tftCurrency,[]);
  Tabela.AddField('AliquotaTributo',tftCurrency,[]);
  Tabela.AddField('ValorTributo',tftCurrency,[]);
  Tabela.AddFieldUpdate;

  FIndicador := Tabela.Table['Indicador'];
  FAliquotaTributo  := Tabela.Table['AliquotaTributo'];
  FDataInicial := Tabela.Table['DataInicial'];
  FDataFinal := Tabela.Table['DataFinal'];
  FValorReceitaBruta := Tabela.Table['ValorReceitaBruta'];
  FValorReceitaBrutaTributada := Tabela.Table['ValorReceitaBrutaTributada'];
  FAliquotaTributo := Tabela.Table['AliquotaTributo'];
  FValorTributo := Tabela.Table['ValorTributo'];
end;



function TTabela.GetAliquotaTributo: currency;
begin
  SetarRegistro;
  result := FAliquotaTributo.GetCurrency(pointer(Registro.SBF));
end;



function TTabela.GetDataFinal: TDateTime;
begin
  SetarRegistro;
  result := FDataFinal.GetDouble(pointer(Registro.SBF));
end;



function TTabela.GetDataInicial: TDateTime;
begin
  SetarRegistro;
  result := FDataInicial.GetDouble(pointer(Registro.SBF));
end;



function TTabela.GetIndicador: integer;
begin
  SetarRegistro;
  result := FIndicador.GetInteger(pointer(Registro.SBF));
end;



function TTabela.GetValorReceitaBruta: currency;
begin
  SetarRegistro;
  result := FValorReceitaBruta.GetCurrency(pointer(Registro.SBF));
end;



function TTabela.GetValorReceitaBrutaTributada: currency;
begin
  SetarRegistro;
  result := FValorReceitaBrutaTributada.GetCurrency(pointer(Registro.SBF));
end;



function TTabela.GetValorTributo: currency;
begin
  SetarRegistro;
  result := FValorTributo.GetCurrency(pointer(Registro.SBF));
end;



procedure TTabela.SetAliquotaTributo(const Value: currency);
begin
  Registro.SetFieldSBFValue(FAliquotaTributo,FAliquotaTributo.SBF(Value));
end;



procedure TTabela.SetDataFinal(const Value: TDateTime);
begin
  Registro.SetFieldSBFValue(FDataFinal,FDataFinal.SBF(Value));
end;

procedure TTabela.SetDataInicial(const Value: TDateTime);
begin
  Registro.SetFieldSBFValue(FDataInicial,FDataInicial.SBF(Value));
end;



procedure TTabela.SetIndicador(const Value: integer);
begin
  Registro.SetFieldSBFValue(FIndicador,FIndicador.SBF(Value));
end;



procedure TTabela.SetValorReceitaBruta(const Value: currency);
begin
  Registro.SetFieldSBFValue(FValorReceitaBruta,FValorReceitaBruta.SBF(Value));
end;



procedure TTabela.SetValorReceitaBrutaTributada(const Value: currency);
begin
  Registro.SetFieldSBFValue(FValorReceitaBrutaTributada,FValorReceitaBrutaTributada.SBF(Value));
end;



procedure TTabela.SetValorTributo(const Value: currency);
begin
  Registro.SetFieldSBFValue(FValorTributo,FValorTributo.SBF(Value));
end;



end.

.. and using de TTabela like a ClietDataSet :-) , but mutch faster...

tb := TTAbela.Create;
for i:=1 to (1000) do
begin
  tb.Insert;
  tb.Indicador := i;
  tb.ValorReceitaBruta := i*100;
  tb.DataInicial := date - i;
  tb.DataFinal := date+i;
  tb.ValorReceitaBrutaTributada := i*100;
  tb.AliquotaTributo := 17;
  tb.ValorTributo := i*17;
  tb.Save;
end;
tb.SaveFile;


f tb.FindKey(['DataInicial','DataFinal' ,'ValorReceitaBruta'],  [41445, 41445, 41445]) then
begin
  while not(tb.Eof) do
  begin
    stringlist.add('Value: ' + formatCurr('0.00',   tb.ValorReceitaBruta   );
    tb.Next;
  end;
...

Please feel free to suggest improvements.

by the way, thank you ab...
the big table can not save our souls, but it can save our necks :-D

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 13,187

Website

Re: alternative to find a record with multiples fields

Nice code!

Thanks for sharing.
Some very good starting point.