Testing data processing

This commit is contained in:
Michael Schimmel
2025-07-27 08:39:16 +02:00
parent aa53a88953
commit 468adcf203
8 changed files with 261 additions and 173 deletions
+2 -1
View File
@@ -7,7 +7,8 @@ uses
MainForm in 'MainForm.pas' {Form1}, MainForm in 'MainForm.pas' {Form1},
TestModule in 'TestModule.pas', TestModule in 'TestModule.pas',
DynamicFMXControl in 'DynamicFMXControl.pas', DynamicFMXControl in 'DynamicFMXControl.pas',
Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas'; Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas',
TestMethodCallFromRecordParams in 'TestMethodCallFromRecordParams.pas';
{$R *.res} {$R *.res}
+1
View File
@@ -138,6 +138,7 @@
<DCCReference Include="TestModule.pas"/> <DCCReference Include="TestModule.pas"/>
<DCCReference Include="DynamicFMXControl.pas"/> <DCCReference Include="DynamicFMXControl.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/> <DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/>
<DCCReference Include="TestMethodCallFromRecordParams.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
+1
View File
@@ -205,6 +205,7 @@ object Form1: TForm1
TabOrder = 0 TabOrder = 0
Text = 'Button1' Text = 'Button1'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = Button1Click
end end
end end
end end
+16 -10
View File
@@ -52,7 +52,8 @@ uses
DynamicFMXControl, DynamicFMXControl,
Myc.FMX.Chart, Myc.FMX.Chart,
Myc.Trade.Indicators, Myc.Trade.Indicators,
StrategyTest; StrategyTest,
TestMethodCallFromRecordParams;
type type
TForm1 = class(TForm) TForm1 = class(TForm)
@@ -87,6 +88,7 @@ type
procedure StopButtonClick(Sender: TObject); procedure StopButtonClick(Sender: TObject);
procedure TreeViewDblClick(Sender: TObject); procedure TreeViewDblClick(Sender: TObject);
procedure AddWorkspaceActionExecute(Sender: TObject); procedure AddWorkspaceActionExecute(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Strat2ButtonClick(Sender: TObject); procedure Strat2ButtonClick(Sender: TObject);
procedure TestActionExecute(Sender: TObject); procedure TestActionExecute(Sender: TObject);
procedure StrategyButtonClick(Sender: TObject); procedure StrategyButtonClick(Sender: TObject);
@@ -285,6 +287,11 @@ begin
Control.Align := TAlignLayout.Top; Control.Align := TAlignLayout.Top;
end; end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Test1(LogMemo.Lines);
end;
function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>; function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>;
type type
TSignal = record TSignal = record
@@ -478,21 +485,20 @@ begin
pnlChart.SetXAxisCounter<Double>(equity.Producer); pnlChart.SetXAxisCounter<Double>(equity.Producer);
//////////// ////////////
var EMAFactory := TEMA.Create;
var Params := TDataRecord.Create(EMAFactory.Params); var Params: TEMA.TParam;
Params.SetValue<Integer>('Period', 20); Params.Period := 20;
var indi := EMAFActory.CreateIndicator(Params); var indi := TEMA.CreateEMA(Params);
var EMAConv := TConverter<TDataRecord, TDataRecord>.CreateConverter(indi); var EMAConv := TConverter<TEMA.TInput, TEMA.TResult>.CreateConverter(indi);
var equityEMA := var equityEMA :=
equity equity
.Producer .Producer
.Chain<TDataRecord>(EMAFactory.Input.FieldAsRecord<Double>('Price')) .Chain<TEMA.TInput>(function(const Value: Double): TEMA.TInput begin Result.Price := Value end)
.Chain<TDataRecord>(EMAConv) .Chain<TEMA.TResult>(EMAConv)
.Chain<Double>(EMAFactory.Output.FieldOfRecord<Double>('MA')); .Chain<Double>(function(const Value: TEMA.TResult): Double begin Result := Value.MA end);
////////////// //////////////
@@ -675,7 +681,7 @@ begin
exit; exit;
var timeframe := TTimeframe.M15; var timeframe := TTimeframe.M15;
//ExecuteStrategy(Symbol, timeframe, CreateStrategy2(timeframe)); ExecuteStrategy(Symbol, timeframe, CreateStrategy2(timeframe));
var tstStrat := StrategyTest.CreateStrategy1(timeframe); var tstStrat := StrategyTest.CreateStrategy1(timeframe);
ExecuteStrategy(Symbol, timeframe, tstStrat.Consumer); ExecuteStrategy(Symbol, timeframe, tstStrat.Consumer);
@@ -0,0 +1,134 @@
unit TestMethodCallFromRecordParams;
interface
// We need RTTI here!
{$M+}
uses
System.Rtti,
System.SysUtils,
System.TypInfo,
System.Classes,
Myc.Data.Records;
type
InvokeAttribute = class(TCustomAttribute);
FactoryAttribute = class(TCustomAttribute);
TMyProc<TValue, TResult> = reference to function(const [ref] Value: TValue): TResult;
TFactoryProc<TParams, TValue, TResult> = reference to function(const [ref] Params: TParams): TMyProc<TValue, TResult>;
TMyWorker = record
type
TParams = record
Log: Int64;
text: String;
end;
TValue = record
xyz: Double;
end;
TResult = record
val: Int64;
desc: String;
end;
[Factory]
class function CreateFactory: TFactoryProc<TParams, TValue, TResult>; static;
end;
procedure Test1(const Log: TStrings);
implementation
class function TMyWorker.CreateFactory: TFactoryProc<TParams, TValue, TResult>;
begin
Result :=
function(const [ref] Params: TParams): TMyProc<TValue, TResult>
begin
var Log := TStrings(Params.Log);
var text := Params.text;
Result :=
function(const [ref] Value: TValue): TResult
begin
// Use Format to avoid locale issues with float conversion
Log.Add(Format('Val=%f (...%s)', [Value.xyz, text]));
Result.desc := 'done';
end;
end;
end;
type
TInvokeProc = reference to procedure(const Value, Res: TDataRecord);
function CreateInvoker(Ctx: TRttiContext; CallFunc: TValue): TInvokeProc;
begin
var rttiMyProc := Ctx.GetType(CallFunc.TypeInfo);
var workerInvokeMethod := rttiMyProc.GetMethod('Invoke');
var workerParamTypeInfo := workerInvokeMethod.GetParameters[0].ParamType.Handle;
var args: array[0..0] of TValue;
Result :=
procedure(const Value, Res: TDataRecord)
begin
TValue.MakeWithoutCopy(Value.RawData, workerParamTypeInfo, args[0], true);
workerInvokeMethod.Invoke(CallFunc, args).ExtractRawData(Res.RawData);
end;
end;
procedure Test1(const Log: TStrings);
begin
var params := TDataRecord.FromRecord<TMyWorker.TParams>;
params.SetValue<Int64>('Log', Int64(Log));
params.SetValue<String>('text', 'The quick brown fox jumps...');
var workerValueParam := TDataRecord.FromRecord<TMyWorker.TValue>;
workerValueParam.SetValue<Double>('xyz', 3.14159);
var finalResultRec := TDataRecord.FromRecord<TMyWorker.TResult>;
var invoke: TInvokeProc;
////////////
var Ctx := TRttiContext.Create;
var rttiType := Ctx.GetType(TypeInfo(TMyWorker));
// Find and invoke the method marked with [Factory] attribute.
for var method in rttiType.GetMethods do
begin
if method.HasAttribute<FactoryAttribute> then
begin
// First invocation returns the factory procedure itself (an interface).
var createFuncValue := method.Invoke(TValue.Empty, []);
// Anonymous methods are interfaces, so we get the TRttiInterfaceType.
var rttiCreateFunc := Ctx.GetType(createFuncValue.TypeInfo) as TRttiInterfaceType;
// The actual code is in the 'Invoke' method of that interface.
var factoryInvokeMethod := rttiCreateFunc.GetMethod('Invoke');
// Prepare the argument for the factory proc: a pointer to 'params'
var factoryArg: array[0..0] of TValue;
var factoryParamTypeInfo := factoryInvokeMethod.GetParameters[0].ParamType.Handle;
TValue.Make(params.RawData, factoryParamTypeInfo, factoryArg[0]);
var myProcValue := factoryInvokeMethod.Invoke(createFuncValue, factoryArg);
invoke := CreateInvoker(Ctx, myProcValue);
break;
end;
end;
//////////
Assert(Assigned(invoke));
invoke(workerValueParam, finalResultRec);
var desc := finalResultRec.GetValue<String>('desc');
Log.Add('Final result description: ' + desc);
Assert(desc = 'done');
end;
end.
+82 -50
View File
@@ -15,11 +15,12 @@ type
TField = record TField = record
private private
FFieldType: TFieldType; FFieldType: TFieldType;
FTypeInfo: PtypeInfo;
FName: string; FName: string;
FOffset: Integer; FOffset: Integer;
procedure FromType(const [ref] Buffer: TBytes; SrcType: PTypeInfo; const Src); procedure FromType(const [ref] Buffer: TBytes; const Src);
procedure ToType(const [ref] Buffer: TBytes; DstType: PTypeInfo; var Dst); procedure ToType(const [ref] Buffer: TBytes; var Dst);
procedure InitField(const [ref] Buffer: TBytes); procedure InitField(const [ref] Buffer: TBytes);
procedure AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes); procedure AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes);
@@ -29,7 +30,7 @@ type
property Offset: Integer read FOffset; property Offset: Integer read FOffset;
constructor Create(const AName: string; AFieldType: TFieldType; AOffset: Integer); constructor Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);
function GetSize: Integer; inline; function GetSize: Integer; inline;
function GetAlignedSize: Integer; inline; function GetAlignedSize: Integer; inline;
@@ -39,6 +40,7 @@ type
property Name: string read FName; property Name: string read FName;
property Size: Integer read GetSize; property Size: Integer read GetSize;
property AlignedSize: Integer read GetAlignedSize; property AlignedSize: Integer read GetAlignedSize;
property TypeInfo: PTypeInfo read FTypeInfo;
end; end;
TFieldDef = record TFieldDef = record
@@ -67,6 +69,7 @@ type
private private
FLayout: TLayout; FLayout: TLayout;
FBuffer: TBytes; FBuffer: TBytes;
function GetRawData: Pointer; inline;
public public
constructor Create(const ALayout: TLayout); constructor Create(const ALayout: TLayout);
@@ -77,14 +80,18 @@ type
class function FromRecord<T>: TDataRecord; overload; static; class function FromRecord<T>: TDataRecord; overload; static;
class function FromRecord<T>(const Src: T): TDataRecord; overload; static; class function FromRecord<T>(const Src: T): TDataRecord; overload; static;
procedure CopyFrom<T>(const Src: T);
procedure SetValue<T>(const Name: String; const Value: T); overload; procedure SetValue<T>(const Name: String; const Value: T); overload;
procedure SetValue(Idx: Integer; const Value); overload; procedure SetValue(Idx: Integer; const Value); overload;
function GetValue<T>(const Name: String): T; overload; function GetValue<T>(const Name: String): T; overload;
procedure GetValue(Idx: Integer; out Value); overload; procedure GetValue(Idx: Integer; out Value); overload;
function GetValueRef(Idx: Integer): Pointer; overload;
procedure CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer); procedure CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
property RawData: Pointer read GetRawData;
property Layout: TLayout read FLayout; property Layout: TLayout read FLayout;
end; end;
@@ -113,6 +120,19 @@ begin
FLayout.Fields[i].InitField(FBuffer); FLayout.Fields[i].InitField(FBuffer);
end; end;
procedure TDataRecord.CopyFrom<T>(const Src: T);
begin
var ctx := TRttiContext.Create;
var rttiType := ctx.GetType(TypeInfo(T));
for var i := 0 to High(FLayout.FFields) do
begin
var P: PByte := @Src;
inc(P, FLayout.Fields[i].Offset);
FLayout.Fields[i].FromType(FBuffer, Src);
end;
end;
procedure TDataRecord.CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer); procedure TDataRecord.CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
begin begin
Assert(SrcRec.Layout.Fields[SrcIdx].FieldType = FLayout.Fields[SrcIdx].FieldType); Assert(SrcRec.Layout.Fields[SrcIdx].FieldType = FLayout.Fields[SrcIdx].FieldType);
@@ -131,24 +151,12 @@ end;
class function TDataRecord.FromRecord<T>(const Src: T): TDataRecord; class function TDataRecord.FromRecord<T>(const Src: T): TDataRecord;
begin begin
Result.Create(TLayout.FromRecord<T>); Result.Create(TLayout.FromRecord<T>);
Result.CopyFrom<T>(Src);
end;
var ctx := TRttiContext.Create; function TDataRecord.GetRawData: Pointer;
var rttiType := ctx.GetType(TypeInfo(T)); begin
var rttiFields := rttiType.GetFields; Result := @FBuffer[0];
var fields: TArray<TField>;
for var i := 0 to High(rttiFields) do
begin
var rf := rttiFields[i];
var idx := Result.Layout.IndexOf(rf.Name);
if (idx >= 0) then
begin
var S: PByte := @Src;
inc(S, rf.Offset);
Result.Layout.Fields[idx].FromType(Result.FBuffer, rf.FieldType.Handle, S^);
end;
end;
end; end;
procedure TDataRecord.GetValue(Idx: Integer; out Value); procedure TDataRecord.GetValue(Idx: Integer; out Value);
@@ -183,14 +191,25 @@ function TDataRecord.GetValue<T>(const Name: String): T;
begin begin
var idx := FLayout.IndexOf(Name); var idx := FLayout.IndexOf(Name);
if (idx >= 0) then if (idx >= 0) then
FLayout.Fields[idx].ToType(FBuffer, TypeInfo(T), Result); begin
Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
FLayout.Fields[idx].ToType(FBuffer, Result);
end;
end;
function TDataRecord.GetValueRef(Idx: Integer): Pointer;
begin
Result := @FBuffer[FLayout.Fields[Idx].Offset];
end; end;
procedure TDataRecord.SetValue<T>(const Name: String; const Value: T); procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
begin begin
var idx := FLayout.IndexOf(Name); var idx := FLayout.IndexOf(Name);
if (idx >= 0) then if (idx >= 0) then
FLayout.Fields[idx].FromType(FBuffer, TypeInfo(T), Value); begin
Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
FLayout.Fields[idx].FromType(FBuffer, Value);
end;
end; end;
class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord); class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
@@ -211,11 +230,12 @@ begin
Dest.Layout.Fields[i].FinalizeField(Dest.FBuffer); Dest.Layout.Fields[i].FinalizeField(Dest.FBuffer);
end; end;
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; AOffset: Integer); constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);
begin begin
FName := AName; FName := AName;
FFieldType := AFieldType; FFieldType := AFieldType;
FOffset := AOffset; FOffset := AOffset;
FTypeInfo := ATypeInfo;
end; end;
procedure TDataRecord.TField.InitField(const [ref] Buffer: TBytes); procedure TDataRecord.TField.InitField(const [ref] Buffer: TBytes);
@@ -246,7 +266,7 @@ begin
end; end;
end; end;
procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; SrcType: PTypeInfo; const Src); procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; const Src);
begin begin
Assert(FOffset + Size <= Length(Buffer)); Assert(FOffset + Size <= Length(Buffer));
@@ -254,9 +274,9 @@ begin
case FFieldType of case FFieldType of
dfFloat: dfFloat:
begin begin
Assert(SrcType.Kind = tkFloat); Assert(FTypeInfo.Kind = tkFloat);
case GetTypeData(SrcType).FloatType of case GetTypeData(FTypeInfo).FloatType of
ftSingle: PDouble(Dst)^ := PSingle(@Src)^; ftSingle: PSingle(Dst)^ := PSingle(@Src)^;
ftDouble: PDouble(Dst)^ := PDouble(@Src)^; ftDouble: PDouble(Dst)^ := PDouble(@Src)^;
else else
Assert(false); Assert(false);
@@ -264,8 +284,8 @@ begin
end; end;
dfInteger: dfInteger:
begin begin
case SrcType.Kind of case FTypeInfo.Kind of
tkInteger: PInt64(Dst)^ := PInteger(@Src)^; tkInteger: PInteger(Dst)^ := PInteger(@Src)^;
tkInt64: PInt64(Dst)^ := PInt64(@Src)^; tkInt64: PInt64(Dst)^ := PInt64(@Src)^;
else else
Assert(false); Assert(false);
@@ -273,19 +293,19 @@ begin
end; end;
dfString: dfString:
begin begin
Assert(SrcType.Kind in [tkString, tkLString, tkUString, tkWString]); Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
PString(Dst)^ := PString(@Src)^; PString(Dst)^ := PString(@Src)^;
end; end;
dfTimestamp: dfTimestamp:
begin begin
Assert(SrcType.Kind = tkFloat); Assert(FTypeInfo.Kind = tkFloat);
Assert(SrcType.Name = PTypeInfo(TypeInfo(TDateTime)).Name); Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
PDateTime(Dst)^ := PDateTime(@Src)^; PDateTime(Dst)^ := PDateTime(@Src)^;
end; end;
dfRecord: dfRecord:
begin begin
Assert(SrcType = TypeInfo(TDataRecord)); Assert(FTypeInfo = System.TypeInfo(TDataRecord));
Assert(SrcType.Name = PTypeInfo(TypeInfo(TDataRecord)).Name); Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDataRecord)).Name);
TDataRecord(Dst^) := TDataRecord(Src); TDataRecord(Dst^) := TDataRecord(Src);
end; end;
else else
@@ -303,15 +323,15 @@ begin
Result := (GetSize + (Align - 1)) and not (Align - 1); Result := (GetSize + (Align - 1)) and not (Align - 1);
end; end;
procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; DstType: PTypeInfo; var Dst); procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; var Dst);
begin begin
var Src := @Buffer[FOffset]; var Src := @Buffer[FOffset];
case FFieldType of case FFieldType of
dfFloat: dfFloat:
begin begin
Assert(DstType.Kind = tkFloat); Assert(FTypeInfo.Kind = tkFloat);
case GetTypeData(DstType).FloatType of case GetTypeData(FTypeInfo).FloatType of
ftSingle: PSingle(@Dst)^ := PDouble(Src)^; ftSingle: PSingle(@Dst)^ := PSingle(Src)^;
ftDouble: PDouble(@Dst)^ := PDouble(Src)^; ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
else else
Assert(false); Assert(false);
@@ -319,8 +339,8 @@ begin
end; end;
dfInteger: dfInteger:
begin begin
case DstType.Kind of case FTypeInfo.Kind of
tkInteger: PInteger(@Dst)^ := PInt64(Src)^; tkInteger: PInteger(@Dst)^ := PInteger(Src)^;
tkInt64: PInt64(@Dst)^ := PInt64(Src)^; tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
else else
Assert(false); Assert(false);
@@ -328,18 +348,18 @@ begin
end; end;
dfString: dfString:
begin begin
Assert(DstType.Kind in [tkString, tkLString, tkUString, tkWString]); Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
PString(@Dst)^ := PString(Src)^; PString(@Dst)^ := PString(Src)^;
end; end;
dfTimestamp: dfTimestamp:
begin begin
Assert(DstType.Kind = tkFloat); Assert(FTypeInfo.Kind = tkFloat);
Assert(DstType.Name = PTypeInfo(TypeInfo(TDateTime)).Name); Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
PDateTime(@Dst)^ := PDateTime(Src)^; PDateTime(@Dst)^ := PDateTime(Src)^;
end; end;
dfRecord: dfRecord:
begin begin
Assert(DstType = TypeInfo(TDataRecord)); Assert(FTypeInfo = System.TypeInfo(TDataRecord));
TDataRecord(Dst) := TDataRecord(Src^); TDataRecord(Dst) := TDataRecord(Src^);
end; end;
else else
@@ -383,9 +403,20 @@ begin
var ofs := 0; var ofs := 0;
for var i := 0 to High(Fields) do for var i := 0 to High(Fields) do
begin begin
Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ofs); var ti: PTypeInfo;
case Def[i].FieldType of
dfFloat: ti := TypeInfo(Double);
dfInteger: ti := TypeInfo(Int64);
dfString: ti := TypeInfo(String);
dfTimestamp: ti := TypeInfo(TDateTime);
dfRecord: ti := TypeInfo(TDataRecord);
end;
Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ti, ofs);
inc(ofs, Fields[i].AlignedSize); inc(ofs, Fields[i].AlignedSize);
end; end;
Result.Create(Fields);
end; end;
{ TLayout } { TLayout }
@@ -398,7 +429,7 @@ begin
var fields: TArray<TField>; var fields: TArray<TField>;
// Add each field and its value to the builder // Add each field and its value to the builder
var ofs := 0; // The internal layout has to be the same as the original record
SetLength(fields, Length(rttiFields)); SetLength(fields, Length(rttiFields));
for var i := 0 to High(rttiFields) do for var i := 0 to High(rttiFields) do
begin begin
@@ -407,12 +438,14 @@ begin
var supported := true; var supported := true;
case rf.FieldType.TypeKind of case rf.FieldType.TypeKind of
tkInteger, tkInt64: ft := dfInteger; tkInt64: ft := dfInteger;
tkFloat: tkFloat:
if rf.FieldType.HasName(GetTypeName(TypeInfo(TDateTime))) then if rf.FieldType.HasName(GetTypeName(TypeInfo(TDateTime))) then
ft := dfTimestamp ft := dfTimestamp
else if GetTypeData(rf.FieldType.Handle).FloatType = ftDouble then
ft := dfFloat
else else
ft := dfFloat; supported := false;
tkString, tkWString, tkLString, tkUString: ft := dfString; tkString, tkWString, tkLString, tkUString: ft := dfString;
tkMRecord: tkMRecord:
begin begin
@@ -428,8 +461,7 @@ begin
if not supported then if not supported then
raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records'); raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records');
fields[i] := TField.Create(rf.Name, ft, ofs); fields[i] := TField.Create(rf.Name, ft, rf.FieldType.Handle, rf.Offset);
inc(ofs, fields[i].AlignedSize);
end; end;
Result.Create(fields); Result.Create(fields);
+24 -111
View File
@@ -86,25 +86,7 @@ type
class function CreateMean: TConvertFunc<TArray<Double>, Double>; static; class function CreateMean: TConvertFunc<TArray<Double>, Double>; static;
end; end;
TIndicatorFactory = class TEMA = class
type
TFunc = TConvertFunc<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 type
TParam = record TParam = record
Period: Integer; Period: Integer;
@@ -119,35 +101,9 @@ type
end; end;
public public
constructor Create; class function CreateEMA(const Param: TParam): TConvertFunc<TInput, TResult>; static;
function CreateIndicator(const Params: TDataRecord): TIndicatorFactory.TFunc; override;
end; end;
TMACD = class
type
TParam = record
Fast: TConvertFunc<Double, Double>;
Slow: TConvertFunc<Double, Double>;
Signal: TConvertFunc<Double, Double>;
end;
TInput = record
Price: Double;
end;
TResult = record
MacdLine: Double;
SignalLine: Double;
Histogram: Double;
end;
public
class function CreateMACD(const Param: TParam): TConvertFunc<TInput, TResult>; static;
end;
var
Registry: TList<TIndicatorFactory>;
implementation implementation
{ TIndicators } { TIndicators }
@@ -548,79 +504,36 @@ begin
end; end;
end; end;
// Creates a MACD indicator from three provided moving average functions. class function TEMA.CreateEMA(const Param: TParam): TConvertFunc<TInput, TResult>;
class function TMACD.CreateMACD(const Param: TParam): TConvertFunc<TInput, TResult>;
begin begin
Result := var Period := Param.Period;
function(const Input: TInput): TResult var lastEma: Double := Double.NaN;
var var sourceData: TSeries<Double>;
fastVal, slowVal: Double; var multiplier := 2 / (Period + 1);
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 Result :=
function(const Value: TInput): TResult
begin
sourceData.Add(Value.Price, Period);
if (sourceData.Count < Period) then
begin begin
Result.MacdLine := Double.NaN; Result.MA := Double.NaN;
Result.SignalLine := Double.NaN; Exit;
Result.Histogram := Double.NaN; end;
if not IsNan(lastEma) then
begin
// Subsequent EMA calculation
lastEma := (Value.Price - lastEma) * multiplier + lastEma;
end end
else else
begin begin
Result.MacdLine := fastVal - slowVal; // First EMA is a SMA of the initial period
Result.SignalLine := Param.Signal(Result.MacdLine); lastEma := TIndicators.CalculateSMA(sourceData, Period);
if not IsNan(Result.SignalLine) then
Result.Histogram := Result.MacdLine - Result.SignalLine
else
Result.Histogram := Double.NaN;
end; end;
Result.MA := lastEma;
end; end;
end; end;
constructor TEMA.Create;
begin
inherited
Create(TDataRecord.TLayout.FromRecord<TParam>, TDataRecord.TLayout.FromRecord<TInput>, TDataRecord.TLayout.FromRecord<TResult>)
end;
function TEMA.CreateIndicator(const Params: TDataRecord): TIndicatorFactory.TFunc;
begin
var Period := Params.GetValue<Integer>('Period');
var Input := TDataRecord.TLayout.FromRecord<TInput>;
var inPrice := Input.IndexOf('Price');
var Output := TDataRecord.TLayout.FromRecord<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.FromRecord<TResult>;
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. end.
+1 -1
View File
@@ -219,7 +219,7 @@ begin
// Setup: Create the outer record containing the nested TDataRecord // Setup: Create the outer record containing the nested TDataRecord
outerSrc.MyNestedRecord := nestedDataRecord; outerSrc.MyNestedRecord := nestedDataRecord;
// Place a record on the heap. FAILS: This erases the nested record data!! // Place a record on the heap. FAILS: This erases the nested record data!! -- Fixed 25.07.2025!
TDataRecord.FromRecord<TOuterTestRecord>(outerSrc); TDataRecord.FromRecord<TOuterTestRecord>(outerSrc);
// Test: Create the main TDataRecord from the outer record instance // Test: Create the main TDataRecord from the outer record instance