Refactoring DataFlow, 1st Generic Data records working
This commit is contained in:
+27
-196
@@ -11,238 +11,69 @@ uses
|
||||
Myc.DataRecord;
|
||||
|
||||
type
|
||||
// The builder implementation class, now in the global scope.
|
||||
TDataRecordBuilder = class(TInterfacedObject, TDataRecord.TBuilder.IBuilder)
|
||||
private
|
||||
FStagedValues: TList<TPair<string, TValue>>;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
// IBuilder implementation
|
||||
procedure AddField(const Name: String; const Value: TValue); overload;
|
||||
procedure SetupRecord(out Layout: TArray<TDataRecord.TFieldLayout>; out Buffer: TBytes);
|
||||
end;
|
||||
|
||||
type
|
||||
TField = class(TInterfacedObject, TDataRecord.IField)
|
||||
private
|
||||
FBuffer: TBytes;
|
||||
FFieldLayout: TDataRecord.TFieldLayout;
|
||||
protected
|
||||
function GetRawRef: Pointer; inline;
|
||||
public
|
||||
constructor Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
|
||||
procedure GetRaw(Dst: Pointer); virtual;
|
||||
procedure SetRaw(Src: Pointer); virtual;
|
||||
property FieldLayout: TDataRecord.TFieldLayout read FFieldLayout;
|
||||
end;
|
||||
|
||||
type
|
||||
TGenericField<T> = class(TField, TDataRecord.IField<T>)
|
||||
public
|
||||
function GetValue: T;
|
||||
procedure SetValue(const Value: T);
|
||||
end;
|
||||
|
||||
type
|
||||
TIntegerField = class(TGenericField<Integer>)
|
||||
public
|
||||
procedure GetRaw(Dst: Pointer); override;
|
||||
procedure SetRaw(Src: Pointer); override;
|
||||
end;
|
||||
|
||||
type
|
||||
TSingleField = class(TGenericField<Single>)
|
||||
public
|
||||
procedure GetRaw(Dst: Pointer); override;
|
||||
procedure SetRaw(Src: Pointer); override;
|
||||
end;
|
||||
|
||||
type
|
||||
TDoubleField = class(TGenericField<Double>)
|
||||
public
|
||||
procedure GetRaw(Dst: Pointer); override;
|
||||
procedure SetRaw(Src: Pointer); override;
|
||||
end;
|
||||
|
||||
type
|
||||
TInt64Field = class(TGenericField<Int64>)
|
||||
public
|
||||
procedure GetRaw(Dst: Pointer); override;
|
||||
procedure SetRaw(Src: Pointer); override;
|
||||
end;
|
||||
|
||||
type
|
||||
TStringField = class(TGenericField<String>)
|
||||
public
|
||||
procedure GetRaw(Dst: Pointer); override;
|
||||
procedure SetRaw(Src: Pointer); override;
|
||||
end;
|
||||
|
||||
type
|
||||
TFieldLayoutComparer = class(TComparer<TDataRecord.TFieldLayout>)
|
||||
TFieldLayoutComparer = class(TComparer<TDataRecord.TField>)
|
||||
strict private
|
||||
class var
|
||||
FDefaultComparer: IComparer<TDataRecord.TFieldLayout>;
|
||||
FDefaultComparer: IComparer<TDataRecord.TField>;
|
||||
class constructor CreateClass;
|
||||
public
|
||||
function Compare(const Left, Right: TDataRecord.TFieldLayout): Integer; override;
|
||||
class property DefaultComparer: IComparer<TDataRecord.TFieldLayout> read FDefaultComparer;
|
||||
function Compare(const Left, Right: TDataRecord.TField): Integer; override;
|
||||
class property DefaultComparer: IComparer<TDataRecord.TField> read FDefaultComparer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDataRecordBuilder }
|
||||
|
||||
constructor TDataRecordBuilder.Create;
|
||||
(*
|
||||
procedure TIntegerField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
|
||||
begin
|
||||
inherited;
|
||||
FStagedValues := TList<TPair<string, TValue>>.Create;
|
||||
PInteger(Dst)^ := PInteger(GetRawRef(Buffer))^;
|
||||
end;
|
||||
|
||||
destructor TDataRecordBuilder.Destroy;
|
||||
procedure TIntegerField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
|
||||
begin
|
||||
FStagedValues.Free;
|
||||
inherited;
|
||||
PInteger(GetRawRef(Buffer))^ := PInteger(Src)^;
|
||||
end;
|
||||
|
||||
procedure TDataRecordBuilder.AddField(const Name: String; const Value: TValue);
|
||||
procedure TSingleField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
|
||||
begin
|
||||
FStagedValues.Add(TPair<string, TValue>.Create(Name, Value));
|
||||
PSingle(Dst)^ := PSingle(GetRawRef(Buffer))^;
|
||||
end;
|
||||
|
||||
procedure TDataRecordBuilder.SetupRecord(out Layout: TArray<TDataRecord.TFieldLayout>; out Buffer: TBytes);
|
||||
var
|
||||
layoutList: TList<TDataRecord.TFieldLayout>;
|
||||
pair: TPair<string, TValue>;
|
||||
field: TDataRecord.TFieldLayout;
|
||||
procedure TSingleField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
|
||||
begin
|
||||
layoutList := TList<TDataRecord.TFieldLayout>.Create;
|
||||
try
|
||||
layoutList.Capacity := FStagedValues.Count;
|
||||
var ofs: NativeUInt := 0;
|
||||
for pair in FStagedValues do
|
||||
begin
|
||||
field.Name := pair.Key;
|
||||
field.Size := pair.Value.DataSize;
|
||||
ofs := (ofs + 15) and not 15;
|
||||
field.Offset := ofs;
|
||||
inc(ofs, field.Size);
|
||||
field.TypeInfo := pair.Value.TypeInfo;
|
||||
layoutList.Add(field);
|
||||
end;
|
||||
|
||||
SetLength(Buffer, ofs);
|
||||
|
||||
for var i := 0 to layoutList.Count - 1 do
|
||||
begin
|
||||
var P: PByte := @Buffer[layoutList[i].Offset];
|
||||
FStagedValues[i].Value.ExtractRawData(P);
|
||||
end;
|
||||
|
||||
layoutList.Sort(TFieldLayoutComparer.DefaultComparer);
|
||||
Layout := layoutList.ToArray;
|
||||
finally
|
||||
layoutList.Free;
|
||||
end;
|
||||
FStagedValues.Clear;
|
||||
PSingle(GetRawRef(Buffer))^ := PSingle(Src)^;
|
||||
end;
|
||||
|
||||
{ TField and descendants... }
|
||||
constructor TField.Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
|
||||
procedure TDoubleField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
|
||||
begin
|
||||
inherited Create;
|
||||
FBuffer := ABuffer;
|
||||
FFieldLayout := AField;
|
||||
PDouble(Dst)^ := PDouble(GetRawRef(Buffer))^;
|
||||
end;
|
||||
|
||||
procedure TField.GetRaw(Dst: Pointer);
|
||||
var
|
||||
Val: TValue;
|
||||
procedure TDoubleField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
|
||||
begin
|
||||
TValue.MakeWithoutCopy(GetRawRef, FFieldLayout.TypeInfo, val, true);
|
||||
val.ExtractRawData(Dst);
|
||||
PDouble(GetRawRef(Buffer))^ := PDouble(Src)^;
|
||||
end;
|
||||
|
||||
function TField.GetRawRef: Pointer;
|
||||
procedure TInt64Field.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
|
||||
begin
|
||||
Result := @FBuffer[FFieldLayout.Offset];
|
||||
PInt64(Dst)^ := PInt64(GetRawRef(Buffer))^;
|
||||
end;
|
||||
|
||||
procedure TField.SetRaw(Src: Pointer);
|
||||
var
|
||||
Val: TValue;
|
||||
procedure TInt64Field.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
|
||||
begin
|
||||
TValue.MakeWithoutCopy(Src, FFieldLayout.TypeInfo, val, true);
|
||||
val.ExtractRawData(GetRawRef);
|
||||
PInt64(GetRawRef(Buffer))^ := PInt64(Src)^;
|
||||
end;
|
||||
|
||||
{ TGenericField<T> }
|
||||
|
||||
function TGenericField<T>.GetValue: T;
|
||||
type
|
||||
PT = ^T;
|
||||
procedure TStringField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
|
||||
begin
|
||||
Result := PT(@FBuffer[FFieldLayout.Offset])^;
|
||||
PString(Dst)^ := PString(GetRawRef(Buffer))^;
|
||||
end;
|
||||
|
||||
procedure TGenericField<T>.SetValue(const Value: T);
|
||||
type
|
||||
PT = ^T;
|
||||
procedure TStringField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
|
||||
begin
|
||||
PT(@FBuffer[FFieldLayout.Offset])^ := Value;
|
||||
PString(GetRawRef(Buffer))^ := PString(Src)^;
|
||||
end;
|
||||
|
||||
procedure TIntegerField.GetRaw(Dst: Pointer);
|
||||
begin
|
||||
PInteger(Dst)^ := PInteger(GetRawRef)^;
|
||||
end;
|
||||
|
||||
procedure TIntegerField.SetRaw(Src: Pointer);
|
||||
begin
|
||||
PInteger(GetRawRef)^ := PInteger(Src)^;
|
||||
end;
|
||||
|
||||
procedure TSingleField.GetRaw(Dst: Pointer);
|
||||
begin
|
||||
PSingle(Dst)^ := PSingle(GetRawRef)^;
|
||||
end;
|
||||
|
||||
procedure TSingleField.SetRaw(Src: Pointer);
|
||||
begin
|
||||
PSingle(GetRawRef)^ := PSingle(Src)^;
|
||||
end;
|
||||
|
||||
procedure TDoubleField.GetRaw(Dst: Pointer);
|
||||
begin
|
||||
PDouble(Dst)^ := PDouble(GetRawRef)^;
|
||||
end;
|
||||
|
||||
procedure TDoubleField.SetRaw(Src: Pointer);
|
||||
begin
|
||||
PDouble(GetRawRef)^ := PDouble(Src)^;
|
||||
end;
|
||||
|
||||
procedure TInt64Field.GetRaw(Dst: Pointer);
|
||||
begin
|
||||
PInt64(Dst)^ := PInt64(GetRawRef)^;
|
||||
end;
|
||||
|
||||
procedure TInt64Field.SetRaw(Src: Pointer);
|
||||
begin
|
||||
PInt64(GetRawRef)^ := PInt64(Src)^;
|
||||
end;
|
||||
|
||||
procedure TStringField.GetRaw(Dst: Pointer);
|
||||
begin
|
||||
PString(Dst)^ := PString(GetRawRef)^;
|
||||
end;
|
||||
|
||||
procedure TStringField.SetRaw(Src: Pointer);
|
||||
begin
|
||||
PString(GetRawRef)^ := PString(Src)^;
|
||||
end;
|
||||
|
||||
*)
|
||||
{ TFieldLayoutComparer }
|
||||
|
||||
class constructor TFieldLayoutComparer.CreateClass;
|
||||
@@ -250,7 +81,7 @@ begin
|
||||
FDefaultComparer := TFieldLayoutComparer.Create;
|
||||
end;
|
||||
|
||||
function TFieldLayoutComparer.Compare(const Left, Right: TDataRecord.TFieldLayout): Integer;
|
||||
function TFieldLayoutComparer.Compare(const Left, Right: TDataRecord.TField): Integer;
|
||||
begin
|
||||
Result := TComparer<string>.Default.Compare(Left.Name, Right.Name);
|
||||
end;
|
||||
|
||||
+269
-214
@@ -4,280 +4,335 @@ interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
System.Rtti,
|
||||
System.TypInfo;
|
||||
|
||||
type
|
||||
// A record that provides field-level access to managed data, stored in a byte buffer.
|
||||
TDataFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);
|
||||
|
||||
TDataRecord = record
|
||||
public
|
||||
type
|
||||
IField = interface
|
||||
procedure GetRaw(Dst: Pointer);
|
||||
procedure SetRaw(Src: Pointer);
|
||||
end;
|
||||
|
||||
IField<T> = interface(IField)
|
||||
{$region 'private'}
|
||||
function GetValue: T;
|
||||
procedure SetValue(const Value: T);
|
||||
{$endregion}
|
||||
property Value: T read GetValue write SetValue;
|
||||
end;
|
||||
|
||||
TFieldLayout = record
|
||||
Name: string;
|
||||
Offset: Integer;
|
||||
Size: Integer;
|
||||
TypeInfo: PTypeInfo;
|
||||
end;
|
||||
|
||||
// The interface helper record that provides the generic AddField<T> method.
|
||||
TBuilder = record
|
||||
type
|
||||
IBuilder = interface
|
||||
procedure AddField(const Name: String; const Value: TValue); overload;
|
||||
procedure SetupRecord(out Layout: TArray<TFieldLayout>; out Buffer: TBytes);
|
||||
end;
|
||||
|
||||
TField = record
|
||||
private
|
||||
FBuilder: IBuilder;
|
||||
FFieldType: TDataFieldType;
|
||||
FName: string;
|
||||
FOffset: Integer;
|
||||
FSize: Integer;
|
||||
|
||||
procedure Write(SrcType: PTypeInfo; const Src; P: Pointer);
|
||||
procedure Read(Src: Pointer; DstType: PTypeInfo; var Dst);
|
||||
procedure Finalize(P: Pointer);
|
||||
property Offset: Integer read FOffset;
|
||||
property Size: Integer read FSize;
|
||||
|
||||
public
|
||||
constructor Create(const ABuilder: IBuilder);
|
||||
constructor Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
|
||||
|
||||
class operator Implicit(const AValue: IBuilder): TBuilder; overload;
|
||||
class operator Implicit(const AValue: TBuilder): IBuilder; overload;
|
||||
class function From<T>(const AName: string; Offset: Integer): TField; overload; static;
|
||||
class function From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField; overload; static;
|
||||
|
||||
procedure AddField<T>(const Name: String); overload; inline;
|
||||
procedure AddField<T>(const Name: String; const Value: T); overload; inline;
|
||||
property FieldType: TDataFieldType read FFieldType;
|
||||
property Name: string read FName;
|
||||
end;
|
||||
|
||||
function CreateRec: TDataRecord; inline;
|
||||
TLayout = record
|
||||
private
|
||||
FFields: TArray<TField>;
|
||||
public
|
||||
constructor Create(const AFields: TArray<TField>);
|
||||
class function CreateFrom<T>: TLayout; static;
|
||||
function GetBufferSize: Integer;
|
||||
function IndexOf(const Name: String): Integer;
|
||||
property Fields: TArray<TField> read FFields;
|
||||
end;
|
||||
|
||||
private
|
||||
FLayout: TArray<TFieldLayout>;
|
||||
FLayout: TLayout;
|
||||
FBuffer: TBytes;
|
||||
|
||||
public
|
||||
class operator Initialize(out Dest: TDataRecord);
|
||||
constructor Create(const ALayout: TLayout; const ABuffer: TBytes);
|
||||
|
||||
class function CreateFrom<T>: TDataRecord; overload; static;
|
||||
class function CreateFrom<T>(const Src: T): TDataRecord; overload; static;
|
||||
class function CreateFrom(const Layout: TLayout): TDataRecord; overload; static;
|
||||
procedure CopyFrom<T>(const Src: T);
|
||||
|
||||
procedure SetValue<T>(const Name: String; const Value: T); overload;
|
||||
procedure SetValue(Idx: Integer; const Value); overload;
|
||||
|
||||
function GetValue<T>(const Name: String): T; overload;
|
||||
procedure GetValue(Idx: Integer; out Value); overload;
|
||||
|
||||
class operator Finalize(var Dest: TDataRecord);
|
||||
class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
|
||||
|
||||
class function CreateBuilder: TBuilder; static;
|
||||
|
||||
class function CreateFrom<T>(const Rec: T): TDataRecord; static;
|
||||
procedure AssignTo<T>(var Rec: T);
|
||||
function FitsRecord<T>: Boolean;
|
||||
|
||||
function IndexOf(const Name: String): Integer;
|
||||
function GetField(const Name: String): IField; overload;
|
||||
function GetField<T>(const Name: String): IField<T>; overload;
|
||||
|
||||
property Layout: TArray<TFieldLayout> read FLayout;
|
||||
property Layout: TLayout read FLayout;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.DataRecord.Impl;
|
||||
|
||||
{ TDataRecord.TBuilder }
|
||||
|
||||
constructor TDataRecord.TBuilder.Create(const ABuilder: IBuilder);
|
||||
constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
|
||||
begin
|
||||
FBuilder := ABuilder;
|
||||
FLayout := ALayout;
|
||||
FBuffer := ABuffer;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TBuilder.AddField<T>(const Name: String; const Value: T);
|
||||
procedure TDataRecord.CopyFrom<T>(const Src: T);
|
||||
begin
|
||||
FBuilder.AddField(Name, TValue.From<T>(Value));
|
||||
end;
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
var rttiFields := rttiType.GetFields;
|
||||
var fields: TArray<TField>;
|
||||
|
||||
procedure TDataRecord.TBuilder.AddField<T>(const Name: String);
|
||||
begin
|
||||
AddField<T>(Name, Default(T));
|
||||
end;
|
||||
|
||||
function TDataRecord.TBuilder.CreateRec: TDataRecord;
|
||||
begin
|
||||
FBuilder.SetupRecord(Result.FLayout, Result.FBuffer);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.TBuilder.Implicit(const AValue: IBuilder): TBuilder;
|
||||
begin
|
||||
Result.FBuilder := AValue;
|
||||
end;
|
||||
|
||||
class operator TDataRecord.TBuilder.Implicit(const AValue: TBuilder): IBuilder;
|
||||
begin
|
||||
Result := AValue.FBuilder;
|
||||
end;
|
||||
|
||||
{ TDataRecord }
|
||||
|
||||
function TDataRecord.GetField<T>(const Name: String): IField<T>;
|
||||
var
|
||||
idx: Integer;
|
||||
begin
|
||||
idx := IndexOf(Name);
|
||||
if idx < 0 then
|
||||
exit;
|
||||
if TypeInfo(T) <> FLayout[idx].TypeInfo then
|
||||
exit;
|
||||
Result := TGenericField<T>.Create(FBuffer, FLayout[idx]);
|
||||
end;
|
||||
|
||||
class function TDataRecord.CreateBuilder: TBuilder;
|
||||
begin
|
||||
// Create the implementation class and wrap it in the helper record.
|
||||
Result := TDataRecord.TBuilder.Create(TDataRecordBuilder.Create);
|
||||
end;
|
||||
|
||||
class function TDataRecord.CreateFrom<T>(const Rec: T): TDataRecord;
|
||||
var
|
||||
ctx: TRttiContext;
|
||||
rttiType: TRttiType;
|
||||
builder: TBuilder.IBuilder;
|
||||
begin
|
||||
// Create a builder to construct the TDataRecord
|
||||
builder := CreateBuilder;
|
||||
|
||||
// Use RTTI to iterate over the fields of the source record/object
|
||||
ctx := TRttiContext.Create;
|
||||
rttiType := ctx.GetType(TypeInfo(T));
|
||||
|
||||
// Add each field and its value to the builder
|
||||
for var field in rttiType.GetFields do
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
builder.AddField(field.Name, field.GetValue(Pointer(@Rec)));
|
||||
end;
|
||||
var rf := rttiFields[i];
|
||||
var idx := FLayout.IndexOf(rf.Name);
|
||||
|
||||
// Create the final TDataRecord from the builder
|
||||
builder.SetupRecord(Result.FLayout, Result.FBuffer);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.AssignTo<T>(var Rec: T);
|
||||
var
|
||||
ctx: TRttiContext;
|
||||
rttiType: TRttiType;
|
||||
fieldValue: TValue;
|
||||
fieldIndex: Integer;
|
||||
layout: TFieldLayout;
|
||||
begin
|
||||
Assert(FitsRecord<T>);
|
||||
|
||||
// Use RTTI to iterate over the fields of the destination record/object
|
||||
ctx := TRttiContext.Create;
|
||||
rttiType := ctx.GetType(TypeInfo(T));
|
||||
|
||||
for var rttiField in rttiType.GetFields do
|
||||
begin
|
||||
// Find the corresponding field in the TDataRecord by name
|
||||
fieldIndex := IndexOf(rttiField.Name);
|
||||
if fieldIndex >= 0 then
|
||||
if (idx >= 0) then
|
||||
begin
|
||||
layout := FLayout[fieldIndex];
|
||||
// Create a TValue from the data in our buffer
|
||||
TValue.Make(@FBuffer[layout.Offset], layout.TypeInfo, fieldValue);
|
||||
// Assign the value to the destination record's field
|
||||
rttiField.SetValue(Pointer(@Rec), fieldValue);
|
||||
var fld := FLayout.Fields[idx];
|
||||
|
||||
var S: PByte := @Src;
|
||||
inc(S, rf.Offset);
|
||||
var P := @FBuffer[FLayout.Fields[idx].Offset];
|
||||
|
||||
fld.Write(rf.FieldType.Handle, S^, P);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataRecord.FitsRecord<T>: Boolean;
|
||||
class function TDataRecord.CreateFrom(const Layout: TLayout): TDataRecord;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
|
||||
for var rttiField in rttiType.GetFields do
|
||||
begin
|
||||
// Find the corresponding field in the TDataRecord by name
|
||||
var fieldIndex := IndexOf(rttiField.Name);
|
||||
if fieldIndex < 0 then
|
||||
exit(false);
|
||||
|
||||
if rttiField.DataType.Handle <> FLayout[fieldIndex].TypeInfo then
|
||||
exit(false);
|
||||
end;
|
||||
exit(true);
|
||||
var buf: TBytes;
|
||||
SetLength(buf, Layout.GetBufferSize);
|
||||
Result.Create(Layout, buf);
|
||||
end;
|
||||
|
||||
function TDataRecord.GetField(const Name: String): IField;
|
||||
var
|
||||
idx: Integer;
|
||||
{ TDataRecord }
|
||||
|
||||
class function TDataRecord.CreateFrom<T>: TDataRecord;
|
||||
begin
|
||||
idx := IndexOf(Name);
|
||||
if idx < 0 then
|
||||
exit;
|
||||
var typeInfo := FLayout[idx].TypeInfo;
|
||||
case typeInfo.Kind of
|
||||
tkInteger: Result := TIntegerField.Create(FBuffer, FLayout[idx]);
|
||||
tkFloat:
|
||||
case GetTypeData(typeInfo).FloatType of
|
||||
ftSingle: Result := TSingleField.Create(FBuffer, FLayout[idx]);
|
||||
ftDouble: Result := TDoubleField.Create(FBuffer, FLayout[idx]);
|
||||
end;
|
||||
tkInt64: Result := TInt64Field.Create(FBuffer, FLayout[idx]);
|
||||
tkString: Result := TStringField.Create(FBuffer, FLayout[idx]);
|
||||
end;
|
||||
if not Assigned(Result) then
|
||||
Result := TField.Create(FBuffer, FLayout[idx]);
|
||||
Result := CreateFrom(TLayout.CreateFrom<T>);
|
||||
end;
|
||||
|
||||
function TDataRecord.IndexOf(const Name: String): Integer;
|
||||
var
|
||||
dummyLayout: TFieldLayout;
|
||||
class function TDataRecord.CreateFrom<T>(const Src: T): TDataRecord;
|
||||
begin
|
||||
dummyLayout.Name := Name;
|
||||
if not TArray.BinarySearch<TFieldLayout>(FLayout, dummyLayout, Result, TFieldLayoutComparer.DefaultComparer) then
|
||||
Result := -1;
|
||||
Result := CreateFrom<T>;
|
||||
Result.CopyFrom<T>(Src);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
|
||||
procedure TDataRecord.GetValue(Idx: Integer; out Value);
|
||||
begin
|
||||
Finalize(Dest);
|
||||
|
||||
Dest.FLayout := Src.FLayout;
|
||||
SetLength(Dest.FBuffer, Length(Src.FBuffer));
|
||||
for var i := 0 to High(Dest.FLayout) do
|
||||
begin
|
||||
Assert(Dest.FLayout[i].Name = Src.Layout[i].Name);
|
||||
Assert(Dest.FLayout[i].Offset = Src.Layout[i].Offset);
|
||||
Assert(Dest.FLayout[i].Size = Src.Layout[i].Size);
|
||||
Assert(Dest.FLayout[i].TypeInfo = Src.Layout[i].TypeInfo);
|
||||
|
||||
var ofs := Dest.FLayout[i].Offset;
|
||||
var P: PByte := @Dest.FBuffer[ofs];
|
||||
var Q: PByte := @Src.FBuffer[ofs];
|
||||
var Val: TValue;
|
||||
TValue.Make(Q, Dest.FLayout[i].TypeInfo, val);
|
||||
val.ExtractRawData(P);
|
||||
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
||||
case FLayout.Fields[Idx].FieldType of
|
||||
dfFloat: Double(Value) := PDouble(P)^;
|
||||
dfInteger: Int64(Value) := PInt64(Value)^;
|
||||
dfString: String(Value) := PString(Value)^;
|
||||
dfTimestamp: TDateTime(Value) := PDateTime(Value)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Initialize(out Dest: TDataRecord);
|
||||
procedure TDataRecord.SetValue(Idx: Integer; const Value);
|
||||
begin
|
||||
Dest.FLayout := nil;
|
||||
Dest.FBuffer := nil;
|
||||
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
||||
case FLayout.Fields[Idx].FieldType of
|
||||
dfFloat: PDouble(P)^ := Double(Value);
|
||||
dfInteger: PInt64(P)^ := Int64(Value);
|
||||
dfString: PString(P)^ := String(Value);
|
||||
dfTimestamp: PDateTime(P)^ := TDateTime(Value);
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataRecord.GetValue<T>(const Name: String): T;
|
||||
begin
|
||||
var idx := FLayout.IndexOf(Name);
|
||||
if (idx >= 0) then
|
||||
FLayout.Fields[idx].Read(@FBuffer[FLayout.Fields[idx].Offset], TypeInfo(T), Result);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
|
||||
begin
|
||||
var idx := FLayout.IndexOf(Name);
|
||||
if (idx >= 0) then
|
||||
FLayout.Fields[idx].Write(TypeInfo(T), Value, @FBuffer[FLayout.Fields[idx].Offset]);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Finalize(var Dest: TDataRecord);
|
||||
begin
|
||||
if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
|
||||
Exit;
|
||||
for var i := 0 to High(Dest.FLayout.Fields) do
|
||||
Dest.FLayout.Fields[i].Finalize(@Dest.FBuffer[Dest.FLayout.Fields[i].Offset]);
|
||||
end;
|
||||
|
||||
for var layout in Dest.FLayout do
|
||||
begin
|
||||
var P: PByte := @Dest.FBuffer[layout.Offset];
|
||||
var Val: TValue;
|
||||
// IsMoved has to be false, because we want the local TValue to own the field and destroy it when it looses scope!
|
||||
TValue.MakeWithoutCopy(P, layout.TypeInfo, val, false);
|
||||
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
|
||||
begin
|
||||
FName := AName;
|
||||
FFieldType := AFieldType;
|
||||
FOffset := AOffset;
|
||||
FSize := ASize;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Finalize(P: Pointer);
|
||||
begin
|
||||
case FFieldType of
|
||||
dfFloat: PDouble(P)^ := 0;
|
||||
dfInteger: PInt64(P)^ := 0;
|
||||
dfString: PString(P)^ := '';
|
||||
dfTimestamp: PDateTime(P)^ := 0;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
Dest.FLayout := nil;
|
||||
Dest.FBuffer := nil;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Write(SrcType: PTypeInfo; const Src; P: Pointer);
|
||||
begin
|
||||
case FFieldType of
|
||||
dfFloat:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
case GetTypeData(SrcType).FloatType of
|
||||
ftSingle: PDouble(P)^ := PSingle(@Src)^;
|
||||
ftDouble: PDouble(P)^ := PDouble(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfInteger:
|
||||
begin
|
||||
case SrcType.Kind of
|
||||
tkInteger: PInt64(P)^ := PInteger(@Src)^;
|
||||
tkInt64: PInt64(P)^ := PInt64(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfString:
|
||||
begin
|
||||
Assert(SrcType.Kind in [tkString, tkLString, tkUString, tkWString]);
|
||||
PString(P)^ := PString(@Src)^;
|
||||
end;
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
PDateTime(P)^ := PDateTime(@Src)^;
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataRecord.TField.From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField;
|
||||
begin
|
||||
case rttiType.TypeKind of
|
||||
tkInteger, tkInt64: Result.Create(AName, dfInteger, Offset, sizeof(Int64));
|
||||
tkFloat:
|
||||
if (rttiType.Name = 'TDateTime') then
|
||||
Result.Create(AName, dfTimestamp, Offset, sizeof(TDateTime))
|
||||
else
|
||||
Result.Create(AName, dfFloat, Offset, sizeof(Double));
|
||||
tkString, tkWString, tkLString, tkUString: Result.Create(AName, dfString, Offset, sizeof(String));
|
||||
else
|
||||
raise Exception.Create('Type not supported');
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataRecord.TField.From<T>(const AName: string; Offset: Integer): TField;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
Result := From(AName, ctx.GetType(TypeInfo(T)), Offset);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Read(Src: Pointer; DstType: PTypeInfo; var Dst);
|
||||
begin
|
||||
case FFieldType of
|
||||
dfFloat:
|
||||
begin
|
||||
Assert(DstType.Kind = tkFloat);
|
||||
case GetTypeData(DstType).FloatType of
|
||||
ftSingle: PSingle(@Dst)^ := PDouble(Src)^;
|
||||
ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfInteger:
|
||||
begin
|
||||
case DstType.Kind of
|
||||
tkInteger: PInteger(@Dst)^ := PInt64(Src)^;
|
||||
tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfString:
|
||||
begin
|
||||
Assert(DstType.Kind in [tkString, tkLString, tkUString, tkWString]);
|
||||
PString(@Dst)^ := PString(Src)^;
|
||||
end;
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(DstType.Kind = tkFloat);
|
||||
PDateTime(@Dst)^ := PDateTime(Src)^;
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDataRecord.TLayout.Create(const AFields: TArray<TField>);
|
||||
begin
|
||||
FFields := AFields;
|
||||
end;
|
||||
|
||||
{ TLayout }
|
||||
|
||||
class function TDataRecord.TLayout.CreateFrom<T>: TLayout;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
var rttiFields := rttiType.GetFields;
|
||||
var fields: TArray<TField>;
|
||||
|
||||
// Add each field and its value to the builder
|
||||
var ofs := 0;
|
||||
SetLength(fields, Length(rttiFields));
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
var rf := rttiFields[i];
|
||||
fields[i] := TField.From(rf.Name, rf.FieldType, ofs);
|
||||
inc(ofs, fields[i].Size);
|
||||
ofs := (ofs + 7) and not 7;
|
||||
end;
|
||||
|
||||
Result.Create(fields);
|
||||
end;
|
||||
|
||||
function TDataRecord.TLayout.GetBufferSize: Integer;
|
||||
begin
|
||||
if (Length(FFields) = 0) then
|
||||
exit(0);
|
||||
|
||||
var n := High(FFields);
|
||||
Result := FFields[n].FOffset + FFields[n].Size;
|
||||
Result := (Result + 7) and not 7;
|
||||
end;
|
||||
|
||||
function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
|
||||
begin
|
||||
for var i := 0 to High(FFields) do
|
||||
if (FFields[i].Name = Name) then
|
||||
exit(i);
|
||||
exit(-1);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -5,6 +5,7 @@ interface
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.SyncObjs,
|
||||
System.Generics.Collections,
|
||||
Myc.Signals,
|
||||
Myc.Mutable,
|
||||
Myc.Core.Notifier,
|
||||
@@ -147,13 +148,11 @@ type
|
||||
|
||||
// A processor implementation that is owned by a controller.
|
||||
TMycContainedProcessor<T> = class(TContainedObject, IMycProcessor<T>)
|
||||
type
|
||||
TProc = function(const Value: T): TState of object;
|
||||
private
|
||||
FProc: TProc;
|
||||
FProc: TConstFunc<T, TState>;
|
||||
function ProcessData(const Value: T): TState;
|
||||
public
|
||||
constructor Create(const Controller: IInterface; const AProc: TProc);
|
||||
constructor Create(const Controller: IInterface; const AProc: TConstFunc<T, TState>);
|
||||
end;
|
||||
|
||||
// Endpoint that collects data into a series.
|
||||
@@ -216,6 +215,33 @@ type
|
||||
property Timeframe: TTimeframe read GetTimeframe;
|
||||
end;
|
||||
|
||||
// Endpoint that collects data into a series.
|
||||
TMycDataJoin<T> = class(TInterfacedObject, TDataProvider<TArray<T>>.IDataProvider)
|
||||
type
|
||||
PItem = ^TItem;
|
||||
TItem = record
|
||||
Next: PItem;
|
||||
Value: T;
|
||||
end;
|
||||
|
||||
private
|
||||
FReceivers: array of record
|
||||
DataProvider: TDataProvider<T>;
|
||||
Processor: TMycContainedProcessor<T>;
|
||||
Tag: TDataProvider<T>.TTag;
|
||||
Queue: TQueue<T>;
|
||||
end;
|
||||
|
||||
FSender: TMycContainedDataProvider<TArray<T>>;
|
||||
FLock: TSpinLock;
|
||||
FCount: Integer;
|
||||
function ProcessData(Idx: Integer; const Value: T): TState;
|
||||
public
|
||||
constructor Create(const ADataProviders: TArray<TDataProvider<T>>);
|
||||
destructor Destroy; override;
|
||||
property Sender: TMycContainedDataProvider<TArray<T>> read FSender implements TDataProvider<TArray<T>>.IDataProvider;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@@ -401,12 +427,6 @@ begin
|
||||
var TypeT := Context.GetType(TypeInfo(T));
|
||||
|
||||
var Fields := Context.GetType(TypeInfo(S)).GetFields;
|
||||
var name := '';
|
||||
if AFieldName = 'Time' then
|
||||
for var i := 0 to High(Fields) do
|
||||
begin
|
||||
name := name + ' ' + Fields[i].Name;
|
||||
end;
|
||||
|
||||
Assert(Assigned(Field), 'Field ' + AFieldName + ' not found');
|
||||
Assert(Field.FieldType.TypeKind = TypeT.TypeKind, 'Incorrect type');
|
||||
@@ -444,7 +464,7 @@ end;
|
||||
|
||||
{ TMycContainedProcessor<T> }
|
||||
|
||||
constructor TMycContainedProcessor<T>.Create(const Controller: IInterface; const AProc: TProc);
|
||||
constructor TMycContainedProcessor<T>.Create(const Controller: IInterface; const AProc: TConstFunc<T, TState>);
|
||||
begin
|
||||
inherited Create(Controller);
|
||||
FProc := AProc;
|
||||
@@ -803,4 +823,79 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMycDataJoin<T> }
|
||||
|
||||
constructor TMycDataJoin<T>.Create(const ADataProviders: TArray<TDataProvider<T>>);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
SetLength(FReceivers, Length(ADataProviders));
|
||||
|
||||
FLock := TSpinLock.Create(false);
|
||||
FCount := Length(FReceivers);
|
||||
|
||||
FSender := TMycContainedDataProvider<TArray<T>>.Create(Self);
|
||||
|
||||
var cFunc :=
|
||||
function(Idx: Integer): TConstFunc<T, TState>
|
||||
begin
|
||||
Result := function(const Value: T): TState begin ProcessData(Idx, Value); end
|
||||
end;
|
||||
|
||||
for var i := 0 to High(FReceivers) do
|
||||
with FReceivers[i] do
|
||||
begin
|
||||
Queue := TQueue<T>.Create;
|
||||
DataProvider := ADataProviders[i];
|
||||
Processor := TMycContainedProcessor<T>.Create(Self, cFunc(i));
|
||||
Tag := DataProvider.Link(Processor);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMycDataJoin<T>.Destroy;
|
||||
begin
|
||||
for var i := High(FReceivers) downto 0 do
|
||||
with FReceivers[i] do
|
||||
begin
|
||||
DataProvider.Unlink(FReceivers[i].Tag);
|
||||
Processor.Free;
|
||||
Queue.Free;
|
||||
end;
|
||||
|
||||
FSender.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMycDataJoin<T>.ProcessData(Idx: Integer; const Value: T): TState;
|
||||
begin
|
||||
var Arr: TArray<T>;
|
||||
|
||||
FLock.Enter;
|
||||
try
|
||||
if FReceivers[Idx].Queue.Count = 0 then
|
||||
dec(FCount);
|
||||
|
||||
if FCount = 0 then
|
||||
begin
|
||||
SetLength(Arr, Length(FReceivers));
|
||||
Arr[Idx] := Value;
|
||||
FCount := Length(FReceivers);
|
||||
for var i := 0 to High(FReceivers) do
|
||||
if i <> Idx then
|
||||
begin
|
||||
Arr[i] := FReceivers[i].Queue.Dequeue;
|
||||
if FReceivers[i].Queue.Count > 0 then
|
||||
dec(FCount);
|
||||
end;
|
||||
end
|
||||
else
|
||||
FReceivers[Idx].Queue.Enqueue(Value);
|
||||
finally
|
||||
FLock.Exit;
|
||||
end;
|
||||
|
||||
if Arr <> nil then
|
||||
FSender.Broadcast(Arr);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -6,7 +6,8 @@ uses
|
||||
Myc.Signals,
|
||||
Myc.Mutable,
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataArray;
|
||||
Myc.Trade.DataArray,
|
||||
Myc.DataRecord;
|
||||
|
||||
type
|
||||
// A generic interface for components that process data of type T.
|
||||
@@ -119,6 +120,24 @@ type
|
||||
class function CreateSequence<T>(Count: Integer; const Parent: TDataProvider<T>): TArray<TConverter<T, T>>; overload; static;
|
||||
|
||||
class function Parallel<T>(Parent: TDataProvider<T>): TConverter<T, T>; static;
|
||||
|
||||
class function FieldToRecord<T>(const Layout: TDataRecord.TLayout; const Name: String): TConverter<T, TDataRecord>; static;
|
||||
class function FieldOfRecord<T>(const Layout: TDataRecord.TLayout; const Name: String): TConverter<TDataRecord, T>; static;
|
||||
|
||||
type
|
||||
TRecordMapping = record
|
||||
Layout: TDataRecord.TLayout;
|
||||
Fields: array of record
|
||||
FromField, ToField: String
|
||||
end;
|
||||
end;
|
||||
|
||||
class function DataMapping(
|
||||
const Inputs: TArray<TRecordMapping>;
|
||||
const Output: TDataRecord.TLayout
|
||||
): TConverter<TArray<TDataRecord>, TDataRecord>; static;
|
||||
|
||||
class function Join<T>(const DataProviders: TArray<TDataProvider<T>>): TDataProvider<TArray<T>>; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -315,6 +334,69 @@ begin
|
||||
Result := TOhlcAggregation.Create(Timeframe);
|
||||
end;
|
||||
|
||||
class function TConverter.DataMapping(
|
||||
const Inputs: TArray<TRecordMapping>;
|
||||
const Output: TDataRecord.TLayout
|
||||
): TConverter<TArray<TDataRecord>, TDataRecord>;
|
||||
var
|
||||
Idxs: array of array of record
|
||||
FromIdx, ToIdx: Integer
|
||||
end;
|
||||
begin
|
||||
SetLength(Idxs, Length(Inputs));
|
||||
for var i := 0 to High(Idxs) do
|
||||
begin
|
||||
SetLength(Idxs[i], Length(Inputs[i].Fields));
|
||||
for var j := 0 to High(Idxs[i]) do
|
||||
begin
|
||||
Idxs[i][j].FromIdx := Inputs[i].Layout.IndexOf(Inputs[i].Fields[j].FromField);
|
||||
Idxs[i][j].ToIdx := Output.IndexOf(Inputs[i].Fields[j].ToField);
|
||||
end;
|
||||
end;
|
||||
|
||||
Result :=
|
||||
TConverter<TArray<TDataRecord>, TDataRecord>.CreateGeneric(
|
||||
function(const Inputs: TArray<TDataRecord>): TDataRecord
|
||||
var
|
||||
tmp: array[0..63] of Byte;
|
||||
begin
|
||||
Result := TDataRecord.CreateFrom(Output);
|
||||
for var i := 0 to High(Idxs) do
|
||||
begin
|
||||
for var j := 0 to High(Idxs[i]) do
|
||||
begin
|
||||
Inputs[i].GetValue(Idxs[i][j].FromIdx, tmp);
|
||||
Result.SetValue(Idxs[i][j].ToIdx, tmp);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
class function TConverter.FieldOfRecord<T>(const Layout: TDataRecord.TLayout; const Name: String): TConverter<TDataRecord, T>;
|
||||
begin
|
||||
var idx := Layout.IndexOf(Name);
|
||||
Result := TConverter<TDataRecord, T>.CreateGeneric(function(const Value: TDataRecord): T begin Value.GetValue(idx, Result); end);
|
||||
end;
|
||||
|
||||
class function TConverter.FieldToRecord<T>(const Layout: TDataRecord.TLayout; const Name: String): TConverter<T, TDataRecord>;
|
||||
begin
|
||||
var idx := Layout.IndexOf(Name);
|
||||
Result :=
|
||||
TConverter<T, TDataRecord>.CreateGeneric(
|
||||
function(const Value: T): TDataRecord
|
||||
begin
|
||||
Result := TDataRecord.CreateFrom(Layout);
|
||||
Result.SetValue(idx, Value);
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
class function TConverter.Join<T>(const DataProviders: TArray<TDataProvider<T>>): TDataProvider<TArray<T>>;
|
||||
begin
|
||||
Result := TMycDataJoin<T>.Create(DataProviders);
|
||||
end;
|
||||
|
||||
class function TConverter.Parallel<T>(Parent: TDataProvider<T>): TConverter<T, T>;
|
||||
begin
|
||||
Result := TMycParallelConverter<T>.Create;
|
||||
|
||||
@@ -5,6 +5,9 @@ interface
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Math,
|
||||
System.Generics.Collections,
|
||||
System.Rtti,
|
||||
Myc.DataRecord,
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataArray;
|
||||
|
||||
@@ -78,8 +81,72 @@ type
|
||||
const AtrFunc: TConstFunc<TOhlcItem, Double>;
|
||||
Multiplier: Double
|
||||
): TConstFunc<TOhlcItem, TKeltnerChannelsResult>; overload; static;
|
||||
|
||||
class function CreateMean: TConstFunc<TArray<Double>, Double>; static;
|
||||
end;
|
||||
|
||||
TIndicatorFactory = class
|
||||
type
|
||||
TFunc = TConstFunc<TDataRecord, TDataRecord>;
|
||||
private
|
||||
FParams: TDataRecord.TLayout;
|
||||
FInput: TDataRecord.TLayout;
|
||||
FOutput: TDataRecord.TLayout;
|
||||
|
||||
public
|
||||
constructor Create(const AParams, AInput, AOutput: TDataRecord.TLayout);
|
||||
|
||||
function CreateIndicator(const Params: TDataRecord): TFunc; virtual; abstract;
|
||||
|
||||
property Params: TDataRecord.TLayout read FParams;
|
||||
property Input: TDataRecord.TLayout read FInput;
|
||||
property Output: TDataRecord.TLayout read FOutput;
|
||||
end;
|
||||
|
||||
TEMA = class(TIndicatorFactory)
|
||||
type
|
||||
TParam = record
|
||||
Period: Integer;
|
||||
end;
|
||||
|
||||
TInput = record
|
||||
Price: Double;
|
||||
end;
|
||||
|
||||
TResult = record
|
||||
MA: Double;
|
||||
end;
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
function CreateIndicator(const Params: TDataRecord): TIndicatorFactory.TFunc; override;
|
||||
end;
|
||||
|
||||
TMACD = class
|
||||
type
|
||||
TParam = record
|
||||
Fast: TConstFunc<Double, Double>;
|
||||
Slow: TConstFunc<Double, Double>;
|
||||
Signal: TConstFunc<Double, Double>;
|
||||
end;
|
||||
|
||||
TInput = record
|
||||
Price: Double;
|
||||
end;
|
||||
|
||||
TResult = record
|
||||
MacdLine: Double;
|
||||
SignalLine: Double;
|
||||
Histogram: Double;
|
||||
end;
|
||||
|
||||
public
|
||||
class function CreateMACD(const Param: TParam): TConstFunc<TInput, TResult>; static;
|
||||
end;
|
||||
|
||||
var
|
||||
Registry: TList<TIndicatorFactory>;
|
||||
|
||||
implementation
|
||||
|
||||
{ TIndicators }
|
||||
@@ -466,4 +533,93 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TIndicators.CreateMean: TConstFunc<TArray<Double>, Double>;
|
||||
begin
|
||||
Result :=
|
||||
function(const Value: TArray<Double>): Double
|
||||
begin
|
||||
if Length(Value) = 0 then
|
||||
exit(NaN);
|
||||
Result := Value[0];
|
||||
for var i := 1 to High(Value) do
|
||||
Result := Result + Value[i];
|
||||
Result := Result / Length(Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Creates a MACD indicator from three provided moving average functions.
|
||||
class function TMACD.CreateMACD(const Param: TParam): TConstFunc<TInput, TResult>;
|
||||
begin
|
||||
Result :=
|
||||
function(const Input: TInput): TResult
|
||||
var
|
||||
fastVal, slowVal: Double;
|
||||
begin
|
||||
fastVal := Param.Fast(Input.Price);
|
||||
slowVal := Param.Slow(Input.Price);
|
||||
|
||||
if IsNan(slowVal) then // slowVal will be the last one to become non-NaN
|
||||
begin
|
||||
Result.MacdLine := Double.NaN;
|
||||
Result.SignalLine := Double.NaN;
|
||||
Result.Histogram := Double.NaN;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result.MacdLine := fastVal - slowVal;
|
||||
Result.SignalLine := Param.Signal(Result.MacdLine);
|
||||
if not IsNan(Result.SignalLine) then
|
||||
Result.Histogram := Result.MacdLine - Result.SignalLine
|
||||
else
|
||||
Result.Histogram := Double.NaN;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TEMA.Create;
|
||||
begin
|
||||
inherited
|
||||
Create(TDataRecord.TLayout.CreateFrom<TParam>, TDataRecord.TLayout.CreateFrom<TInput>, TDataRecord.TLayout.CreateFrom<TResult>)
|
||||
end;
|
||||
|
||||
function TEMA.CreateIndicator(const Params: TDataRecord): TIndicatorFactory.TFunc;
|
||||
begin
|
||||
var Period := Params.GetValue<Integer>('Period');
|
||||
|
||||
var Input := TDataRecord.TLayout.CreateFrom<TInput>;
|
||||
var inPrice := Input.IndexOf('Price');
|
||||
|
||||
var Output := TDataRecord.TLayout.CreateFrom<TResult>;
|
||||
var outMA := Output.IndexOf('MA');
|
||||
|
||||
var CalcEMA := TIndicators.CreateEMA(Period);
|
||||
|
||||
Result :=
|
||||
function(const Input: TDataRecord): TDataRecord
|
||||
begin
|
||||
var Price: Double;
|
||||
Input.GetValue(inPrice, Price);
|
||||
|
||||
var MA := CalcEMA(Price);
|
||||
|
||||
Result := TDataRecord.CreateFrom(Output);
|
||||
Result.SetValue(outMA, MA);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TIndicatorFactory.Create(const AParams, AInput, AOutput: TDataRecord.TLayout);
|
||||
begin
|
||||
inherited Create;
|
||||
FParams := AParams;
|
||||
FInput := AInput;
|
||||
FOutput := AOutput;
|
||||
end;
|
||||
|
||||
initialization
|
||||
Registry := TList<TIndicatorFactory>.Create;
|
||||
Registry.Add(TEMA.Create);
|
||||
|
||||
finalization
|
||||
Registry.Free;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user