* Add indexing

This commit is contained in:
michael 2018-12-26 18:57:08 +00:00
parent 8de41029b1
commit 4dad417429
3 changed files with 459 additions and 29 deletions

View File

@ -756,7 +756,7 @@ type
property Options: TIndexOptions read FOptions write FOptions;
property Source: string read FSource write FSource;
end;
TIndexDefClass = class of TIndexDef;
{ TIndexDefs }
TIndexDefs = class(TDefCollection)
@ -2100,13 +2100,13 @@ Function TIndexDefs.AddIndexDef: TIndexDef;
begin
// Result := inherited add as TIndexDef;
Result:=TIndexDef.Create(Self,'','',[]);
Result:=TIndexDefClass(Self.ItemClass).Create(Self,'','',[]);
end;
procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
begin
TIndexDef.Create(Self,Name,Fields,Options);
TIndexDefClass(Self.ItemClass).Create(Self,Name,Fields,Options);
end;
function TIndexDefs.Find(const IndexName: string): TIndexDef;

View File

@ -39,6 +39,8 @@ type
property IDField : String Read FIDField Write FIDField;
published
Property FieldDefs;
Property Indexes;
Property ActiveIndex;
// redeclared data set properties
property Active;
property BeforeOpen;

View File

@ -9,6 +9,12 @@ uses
type
TBaseJSONDataset = Class;
TJSONIndexDef = class;
// How are rows encoded in the JSON ?
TJSONRowType = (rtJSONObject, // Each row is an object.
rtJSONArray // Each row is an array.
);
{ TJSONFieldMapper }
// This class is responsible for mapping the field objects of the records.
@ -60,6 +66,7 @@ type
TFieldComparer = Class
Private
FDesc: Boolean;
FValue : JSValue;
FField : TField;
FOptions : TLocateOptions;
@ -67,13 +74,15 @@ type
Public
Constructor Create(aDataset : TBaseJSONDataset; aField : TField; aValue : JSValue; aOptions : TLocateOptions);
Function GetFieldValue(RowIndex : integer) : JSValue;
Function CompareRows (RowIndex1,RowIndex2 : Integer) : Integer; virtual;
// First value is always dataset value.
Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; virtual; abstract;
Function Compare (RowIndex : Integer) : Integer; virtual;
Property Value : JSValue read FValue Write FValue;
Property Options : TLocateOptions Read FOptions;
Property Options : TLocateOptions Read FOptions Write FOptions;
Property Dataset : TBaseJSONDataset Read FDataset;
Property Field : TField Read FField;
Property Desc : Boolean Read FDesc Write FDesc;
end;
TFieldComparerClass = Class of TFieldComparer;
@ -112,6 +121,7 @@ type
TRecordComparer = class
private
FDataset: TBaseJSONDataset;
FIndexBased: Boolean;
FItems : Array of TFieldComparer;
FOptions: TLocateOptions;
FValues: TJSValueDynArray;
@ -120,13 +130,19 @@ type
procedure ConstructItems(aFields: String); virtual;
function DataTypeToComparerClass(aFieldType: TFieldType): TFieldComparerClass;
Function Compare(aRowindex : integer) : Integer;
Function CompareRows(aRowindex1,aRowIndex2 : integer) : Integer;
procedure updateFromIndex(aIndex : TJSONIndexDef); virtual;
Public
Constructor Create(aDataset : TBaseJSONDataset; aFields : String; aValues : JSValue; aOptions : TLocateOptions);
Constructor Create(aDataset : TBaseJSONDataset; aIndex : TJSONIndexDef);
Destructor Destroy; override;
Property Dataset : TBaseJSONDataset Read FDataset;
property Items [Index : Integer] : TFieldComparer Read GetFieldComparer;
Property Options : TLocateOptions Read FOptions Write FOptions;
Property Values : TJSValueDynArray Read FValues;
Property IndexBased : Boolean Read FIndexBased;
end;
TRecordComparerClass = Class of TRecordComparer;
{ TBaseJSONDataSet }
@ -135,7 +151,7 @@ type
TJSONIndex = Class
FList : TJSArray; // Indexes of elements in FRows.
FRows : TJSArray;
FDataset : TDataset;
FDataset : TBaseJSONDataset;
private
function GetRecordIndex(aListIndex : Integer): NativeInt;
protected
@ -143,9 +159,9 @@ type
Procedure CreateIndex; Virtual; abstract;
Property List : TJSArray Read FList;
Property Rows : TJSArray Read FRows;
Property Dataset : TDataset Read FDataset;
Property Dataset : TBaseJSONDataset Read FDataset;
Public
Constructor Create(aDataset: TDataset; aRows : TJSArray); reintroduce;
Constructor Create(aDataset: TBaseJSONDataset; aRows : TJSArray); reintroduce;
// Append remainder of FRows to FList.
Procedure AppendToIndex; virtual; abstract;
// Delete aListIndex from list, not from row. Return Recordindex of deleted record.
@ -155,7 +171,7 @@ type
// Insert record into list. By default, this does an append. Return ListIndex of inserted record
Function Insert(aCurrentIndex{%H-}, aRecordIndex : Integer) : Integer; virtual;
// Record at index aCurrentIndex has changed. Update index and return new listindex.
Function Update(aCurrentIndex, aRecordIndex : Integer) : Integer; virtual; abstract;
Function Update(aRecordIndex : Integer) : Integer; virtual; abstract;
// Find list index for Record at index aCurrentIndex. Return -1 if not found.
Function FindRecord(aRecordIndex : Integer) : Integer; virtual; abstract;
// index of record in FRows based on aListIndex in List.
@ -173,12 +189,57 @@ type
Function Append(aRecordIndex : Integer) : Integer; override;
Function Insert(aCurrentIndex, aRecordIndex : Integer) : Integer; override;
Function FindRecord(aRecordIndex : Integer) : Integer; override;
Function Update(aCurrentIndex, aRecordIndex : Integer) : Integer; override;
Function Update(aRecordIndex : Integer) : Integer; override;
end;
{ TSortedJSONIndex }
TSortedJSONIndex = Class(TJSONIndex)
Private
FComparer : TRecordComparer;
FUnique: Boolean;
function FindPos(aRecordIndex: Integer): Integer;
function MergeSort(aList: TJSArray): TJSArray;
Protected
Property Comparer : TRecordComparer Read FComparer Write FComparer;
public
Destructor Destroy; override;
procedure CreateComparer(aIndex: TJSONIndexDef);
Procedure CreateIndex; override;
Procedure AppendToIndex; override;
Function Append(aRecordIndex : Integer) : Integer; override;
Function FindRecord(aRecordIndex : Integer) : Integer; override;
Function Update(aRecordIndex : Integer) : Integer; override;
Property Unique : Boolean Read FUnique Write FUnique;
end;
{ TJSONIndexDef }
TJSONIndexDef = class(TIndexDef)
Private
FIndex : TSortedJSONIndex;
Protected
Property Index : TSortedJSONIndex Read FIndex Write FIndex;
Public
Procedure BuildIndex(aDataset : TBaseJSONDataset);
end;
{ TJSONIndexDefs }
TJSONIndexDefs = Class(TIndexDefs)
private
function GetD(aIndex : Integer): TJSONIndexDef;
procedure SetD(aIndex : Integer; AValue: TJSONIndexDef);
Public
Function AddJSONIndexDef: TJSONIndexDef;
Property Defs[aIndex : Integer] : TJSONIndexDef Read GetD Write SetD; default;
end;
// basic JSON dataset. Does nothing ExtJS specific.
TBaseJSONDataSet = class (TDataSet)
private
FActiveIndex: String;
FIndexes: TJSONIndexDefs;
FMUS: Boolean;
FOwnsData : Boolean;
FDefaultIndex : TJSONIndex; // Default index, built from array
@ -195,11 +256,19 @@ type
FEditIdx : Integer;
FEditRow : JSValue;
FUseDateTimeFormatFields: Boolean;
FRowType: TJSONRowType;
procedure SetActiveIndex(AValue: String);
procedure SetIndexes(AValue: TJSONIndexDefs);
procedure SetMetaData(AValue: TJSObject);
procedure SetRows(AValue: TJSArray);
procedure SetRowType(AValue: TJSONRowType);
protected
// Override this to return customized version.
function CreateIndexDefs: TJSONIndexDefs; virtual;
// override this to return a customized version if you are so inclined
function RecordComparerClass: TRecordComparerClass; virtual;
// Return index of Row in FRows matching keyfields/values. If not found, -1 is returned.
function LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer;
function LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer; virtual;
// dataset virtual methods
function AllocRecordBuffer: TDataRecord; override;
procedure FreeRecordBuffer(var Buffer: TDataRecord); override;
@ -231,6 +300,8 @@ type
function GetRecNo: Integer; override;
Protected
// New methods.
// Build all sorted indexes. Default index is not built.
Procedure BuildIndexes;
// Called when dataset is closed. If OwnsData is true, metadata and rows are freed.
Procedure FreeData; virtual;
// Fill default list.
@ -254,10 +325,16 @@ type
Property MetaData : TJSObject Read FMetaData Write SetMetaData;
// Rows
Property Rows : TJSArray Read FRows Write SetRows;
// RowType
Property RowType : TJSONRowType Read FRowType Write SetRowType;
// Fieldmapper
Property FieldMapper : TJSONFieldMapper Read FFieldMapper;
// FieldClass
Property UseDateTimeFormatFields : Boolean Read FUseDateTimeFormatFields Write FUseDateTimeFormatFields;
// Indexes
Property Indexes : TJSONIndexDefs Read FIndexes Write SetIndexes;
// Active index name. Set to empty for default index.
Property ActiveIndex : String Read FActiveIndex Write SetActiveIndex;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
@ -272,7 +349,10 @@ type
TJSONDataset = Class(TBaseJSONDataset)
published
Property FieldDefs;
// redeclared data set properties
Property RowType;
Property UseDateTimeFormatFields;
Property Indexes;
Property ActiveIndex;
property Active;
property BeforeOpen;
property AfterOpen;
@ -322,6 +402,200 @@ implementation
uses DateUtils;
{ TJSONIndexDef }
procedure TJSONIndexDef.BuildIndex(aDataset : TBaseJSONDataset);
begin
if Findex=Nil then
FIndex:=TSortedJSONIndex.Create(aDataset,aDataset.Rows);
FIndex.CreateComparer(Self);
FIndex.CreateIndex;
end;
{ TJSONIndexDefs }
function TJSONIndexDefs.GetD(aIndex : Integer): TJSONIndexDef;
begin
Result:=Items[aIndex] as TJSONIndexDef;
end;
procedure TJSONIndexDefs.SetD(aIndex : Integer; AValue: TJSONIndexDef);
begin
Items[aIndex]:=aValue;
end;
function TJSONIndexDefs.AddJSONIndexDef: TJSONIndexDef;
begin
Result:=Add as TJSONIndexDef;
end;
{ TSortedJSONIndex }
Function TSortedJSONIndex.MergeSort(aList : TJSArray) : TJSArray;
Var
temp : TJSArray;
l,p,q,e,tail : integer;
insize, nmerges, psize, qsize : Integer;
begin
if aList=Nil then
Exit(Nil);
L:=aList.length;
Result:=TJSArray.new(l);
if L=0 then exit;
insize:=1;
Repeat
p:=0;
Tail:=0;
nmerges := 0; // count number of merges we do in this pass
while (p<L) do
begin
Inc(nmerges); { there exists a merge to be done }
{ step `insize' places along from p }
pSize:=L-P;
if Insize<pSize then
pSize:=InSize;
Q:=P+pSize;
qsize:=insize;
//* now we have two lists; merge them */
while (psize>0) or ((qsize > 0) and (Q<L)) do
begin // /* decide whether next element of merge comes from p or q */
if (psize=0) then
begin // * p is empty; e must come from q. */
e := q; Inc(q); Dec(qsize);
end
else if ((qsize = 0) or (q>=L)) then
begin // * q is empty; e must come from p. */
e := p; Inc(p); Dec(psize);
end
else if (FComparer.CompareRows(Integer(aList[p]),Integer(aList[q])) <= 0) then
begin // * First element of p is lower (or same); * e must come from p. */
e:=p; inc(p); Dec(psize);
end
else
begin // * First element of q is lower; e must come from q. */
e := q; Inc(q); Dec(qsize);
end;
Result[Tail]:=aList[e];
Inc(tail);
end;
p:=q;
end;
// * If we have done only one merge, we're finished. */
if (nmerges <= 1) then //* allow for nmerges==0, the empty list case */
exit;
// * Otherwise repeat, merging lists twice the size */
InSize:=Insize * 2;
// Swap lists for next round.
Temp:=Result;
Result:=aList;
aList:=Temp;
until false;
end;
destructor TSortedJSONIndex.Destroy;
begin
FreeAndNil(FComparer);
Inherited;
end;
procedure TSortedJSONIndex.CreateComparer(aIndex: TJSONIndexDef);
Var
L : TFPList;
I : Integer;
begin
FreeAndNil(FComparer);
FComparer:=TRecordComparer.Create(Dataset,aindex);
end;
procedure TSortedJSONIndex.CreateIndex;
Var
Lst : TJSArray;
Len : Integer;
begin
// CreateIndex is called during constructor. We cannot build index then, so we exit
if FComparer=Nil then
exit;
Len:=FRows.Length-1;
// Temp list, mergsort destroys list
Lst:=TJSArray.New(Len+1);
While Len>=0 do
begin
Lst[Len]:=Len;
Dec(Len);
end;
FList:=MergeSort(Lst);
end;
procedure TSortedJSONIndex.AppendToIndex;
begin
// In theory, we could sort the rest of the list, and then merge the 2 sublists.
CreateIndex;
end;
function TSortedJSONIndex.FindPos(aRecordIndex: Integer): Integer;
Var
L,R,I, CompareRes : Integer;
begin
if not Assigned(FComparer) then
exit;
L := 0;
R := Count - 1;
while (L<=R) do
begin
I := L + (R - L) div 2;
CompareRes := FComparer.CompareRows(aRecordIndex, Integer(Flist[I]));
if (CompareRes>0) then
L := I+1
else
begin
R := I-1;
if (CompareRes=0) then
begin
if Unique then
L := I; // forces end of while loop
end;
end;
end;
Result:=L;
end;
function TSortedJSONIndex.Append(aRecordIndex: Integer): Integer;
begin
Result:=FindPos(aRecordIndex);
// insert in list
FList.Splice(Result,0,aRecordIndex);
end;
function TSortedJSONIndex.FindRecord(aRecordIndex: Integer): Integer;
begin
Result:=FList.indexOf(aRecordIndex);
end;
function TSortedJSONIndex.Update(aRecordIndex: Integer): Integer;
Var
aCurrentIndex : Integer;
begin
// Old pos
aCurrentIndex:=FindRecord(aRecordIndex);
// New pos
Result:=FindPos(aRecordIndex);
if Result<>aCurrentIndex then
FList.Splice(Result,0,FList.Splice(aCurrentIndex,1)[0])
end;
{ TFloatFieldComparer }
function TFloatFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
@ -405,7 +679,11 @@ end;
function TFieldComparer.GetFieldValue(RowIndex: integer): JSValue;
begin
Result:=FDataset.FieldMapper.GetJSONDataForField(FField,FDataset.FRows[Rowindex]);
end;
function TFieldComparer.CompareRows(RowIndex1, RowIndex2: Integer): Integer;
begin
Result:=Compare(RowIndex1,GetFieldValue(RowIndex2));
end;
function TFieldComparer.Compare(RowIndex: Integer): Integer;
@ -435,7 +713,7 @@ begin
L:=TFPList.Create;
try
Dataset.GetFieldList(L,aFields);
if L.Count<>Length(FValues) then
if Not Indexbased and (L.Count<>Length(FValues)) then
Raise EDatabaseError.CreateFmt('Array of values has different length (%d) from array of fields (%d)',[Length(FValues), L.Count]);
SetLength(FItems,L.Count);
For I:=0 to L.Count-1 do
@ -444,7 +722,10 @@ begin
FCC:=DataTypeToComparerClass(F.DataType);
If FCC=Nil then
Raise EDatabaseError.CreateFmt('Cannot locate on field %s of type %s)',[F.FieldName,GetEnumName(TypeInfo(TFieldType),Ord(F.DataType))]);
Fitems[i]:=FCC.Create(FDataset,F,FValues[i],FOptions);
if IndexBased then
Fitems[i]:=FCC.Create(FDataset,F,Null,FOptions)
else
Fitems[i]:=FCC.Create(FDataset,F,FValues[i],FOptions);
end;
finally
L.Free;
@ -486,6 +767,49 @@ begin
end;
end;
function TRecordComparer.CompareRows(aRowindex1, aRowIndex2: integer): Integer;
Var
I,L : Integer;
begin
Result:=0;
I:=0;
L:=Length(FItems);
While (Result=0) and (I<L) do
begin
Result:=Fitems[i].CompareRows(aRowindex1,aRowIndex2);
if (Result<>0) and Fitems[i].Desc then
Result:=-Result;
Inc(I);
end;
end;
procedure TRecordComparer.updateFromIndex(aIndex: TJSONIndexDef);
Var
L : TFPList;
I : Integer;
begin
L:=TFPList.Create;
try
if (aIndex.CaseInsFields<>'') then
begin
Dataset.GetFieldList(L,aIndex.CaseInsFields);
for I:=0 to Length(FItems)-1 do
if L.IndexOf(FItems[i].Field)<>-1 then
Fitems[i].Options:=Fitems[i].Options+[loCaseInsensitive];
end;
L.Clear;
Dataset.GetFieldList(L,aIndex.DescFields);
for I:=0 to Length(FItems)-1 do
Fitems[i].Desc:=(ixDescending in aIndex.Options) or (L.IndexOf(FItems[i].Field)<>-1);
finally
L.Free;
end;
end;
constructor TRecordComparer.Create(aDataset: TBaseJSONDataset; aFields: String; aValues: JSValue; aOptions: TLocateOptions);
begin
FDataset:=aDataset;
@ -500,6 +824,27 @@ begin
ConstructItems(aFields);
end;
constructor TRecordComparer.Create(aDataset: TBaseJSONDataset; aIndex: TJSONIndexDef);
begin
FDataset:=aDataset;
FIndexBased:=True;
if ixCaseInsensitive in aIndex.Options then
FOptions:=[loCaseInsensitive];
ConstructItems(aIndex.Fields);
UpdateFromIndex(aIndex);
end;
destructor TRecordComparer.Destroy;
Var
I : Integer;
begin
For I:=0 to Length(FItems)-1 do
FItems[i].Free;
inherited Destroy;
end;
{ TDefaultJSONIndex }
procedure TDefaultJSONIndex.CreateIndex;
@ -541,17 +886,15 @@ begin
Result:=FList.indexOf(aRecordIndex);
end;
function TDefaultJSONIndex.Update(aCurrentIndex, aRecordIndex: Integer
function TDefaultJSONIndex.Update(aRecordIndex: Integer
): Integer;
begin
Result:=0;
If RecordIndex[aCurrentIndex]<>aRecordIndex then
DatabaseErrorFmt('Inconsistent record index in default index, expected %d, got %d.',[aCurrentIndex,RecordIndex[aCurrentIndex]],Dataset);
Result:=aRecordIndex;
end;
{ TJSONIndex }
constructor TJSONIndex.Create(aDataset: TDataset; aRows: TJSArray);
constructor TJSONIndex.Create(aDataset: TBaseJSONDataset; aRows: TJSArray);
begin
FRows:=aRows;
FList:=TJSArray.New(FRows.length);
@ -651,6 +994,44 @@ begin
FMetaData:=AValue;
end;
procedure TBaseJSONDataSet.SetIndexes(AValue: TJSONIndexDefs);
begin
if FIndexes=AValue then Exit;
FIndexes.Assign(aValue);
if Active then
BuildIndexes;
end;
procedure TBaseJSONDataSet.SetActiveIndex(AValue: String);
Var
Idx : TJSONIndexDef;
begin
if FActiveIndex=AValue then Exit;
if (csLoading in ComponentState) then
FActiveIndex:=AValue
else
begin
if (AValue<>'') then
Idx:=FIndexes.Find(aValue) as TJSONIndexDef
else
Idx:=nil;
FActiveIndex:=AValue;
if Not (csLoading in ComponentState) then
if Idx=Nil then
FCurrentIndex:=FDefaultIndex
else
begin
if Idx.Index=Nil then
Idx.BuildIndex(Self);
FCurrentIndex:=Idx.Index;
end;
if Active then
Resync([rmCenter]);
end;
end;
procedure TBaseJSONDataSet.AddToRows(AValue: TJSArray);
begin
@ -671,6 +1052,13 @@ begin
AddToRows(AValue);
end;
procedure TBaseJSONDataSet.SetRowType(AValue: TJSONRowType);
begin
if FRowType=AValue then Exit;
CheckInactive;
FRowType:=AValue;
end;
function TBaseJSONDataSet.AllocRecordBuffer: TDataRecord;
begin
@ -906,10 +1294,11 @@ end;
procedure TBaseJSONDataSet.InternalPost;
Var
Idx : integer;
I,OldC,NewCurrent,Idx : integer;
B : TBookmark;
begin
NewCurrent:=-1;
GetBookMarkData(ActiveBuffer,B);
if (State=dsInsert) then
begin // Insert or Append
@ -918,16 +1307,22 @@ begin
begin // Append
FDefaultIndex.Append(Idx);
// Must replace this by updating all indexes
if (FCurrentIndex<>FDefaultIndex) then
FCurrentIndex.Append(Idx);
for I:=0 to FIndexes.Count-1 do
begin
NewCurrent:=FIndexes[i].Findex.Append(Idx);
if FIndexes[i].Findex<>FCurrentIndex then
NewCurrent:=-1;
end;
end
else // insert
begin
FCurrent:=FDefaultIndex.Insert(FCurrent,Idx);
// Must replace this by updating all indexes.
// Note that this will change current index.
if (FCurrentIndex<>FDefaultIndex) then
FCurrent:=FCurrentIndex.Insert(FCurrent,Idx);
for I:=0 to FIndexes.Count-1 do
begin
NewCurrent:=FIndexes[i].Findex.Append(Idx);
if FIndexes[i].Findex<>FCurrentIndex then
NewCurrent:=-1;
end;
end;
end
else
@ -937,12 +1332,20 @@ begin
// Update source record
Idx:=FEditIdx;
FRows[Idx]:=FEditRow;
FDefaultIndex.Update(FCurrent,Idx);
FDefaultIndex.Update(Idx);
// Must replace this by updating all indexes.
// Note that this will change current index.
if (FCurrentIndex<>FDefaultIndex) then
FCurrentIndex.Update(FCurrent,Idx);
for I:=0 to FIndexes.Count-1 do
begin
// Determine old index.
NewCurrent:=FCurrentIndex.Update(Idx);
if FIndexes[i].Findex<>FCurrentIndex then
NewCurrent:=-1;
end;
end;
// We have an active index, set current to that index.
if NewCurrent<>-1 then
FCurrent:=NewCurrent;
FEditIdx:=-1;
FEditRow:=Nil;
end;
@ -1117,15 +1520,40 @@ begin
FownsData:=True;
UseDateTimeFormatFields:=False;
FEditIdx:=-1;
FIndexes:=CreateIndexDefs;
end;
destructor TBaseJSONDataSet.Destroy;
begin
FreeAndNil(FIndexes);
FEditIdx:=-1;
FreeData;
inherited;
end;
Function TBaseJSONDataSet.CreateIndexDefs : TJSONIndexDefs;
begin
Result:=TJSONIndexDefs.Create(Self,Self,TJSONIndexDef);
end;
procedure TBaseJSONDataSet.BuildIndexes;
Var
I : integer;
begin
For I:=0 to FIndexes.Count-1 do
FIndexes[i].BuildIndex(Self);
end;
function TBaseJSONDataSet.RecordComparerClass : TRecordComparerClass;
begin
Result:=TRecordComparer;
end;
function TBaseJSONDataSet.LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer;
Var
@ -1134,7 +1562,7 @@ Var
begin
Result:=-1;
Comp:=TRecordComparer.Create(Self,KeyFields,KeyValues,Options);
Comp:=RecordComparerClass.Create(Self,KeyFields,KeyValues,Options);
try
I:=FCurrent;
RI:=FCurrentIndex.GetRecordIndex(I);