Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Generic indicator factory

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-27 14:05:54 +02:00
parent 86001b654f
commit 791f629a10
8 changed files with 1047 additions and 649 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/AuraTrader.dpr
+1 -1
View File
@@ -8,7 +8,7 @@ uses
TestModule in 'TestModule.pas',
DynamicFMXControl in 'DynamicFMXControl.pas',
Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas',
TestMethodCallFromRecordParams in 'TestMethodCallFromRecordParams.pas';
Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas';
{$R *.res}
AuraTrader/AuraTrader.dproj
+1 -1
View File
@@ -138,7 +138,7 @@
<DCCReference Include="TestModule.pas"/>
<DCCReference Include="DynamicFMXControl.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/>
<DCCReference Include="TestMethodCallFromRecordParams.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Indicators.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
AuraTrader/MainForm.pas
+4 -3
View File
@@ -51,7 +51,7 @@ uses
FMX.ActnList,
DynamicFMXControl,
Myc.FMX.Chart,
Myc.Trade.Indicators,
Myc.Trade.Indicators.Common,
StrategyTest,
TestMethodCallFromRecordParams;
@@ -486,6 +486,7 @@ begin
////////////
(*
var Params: TEMA.TParam;
Params.Period := 20;
@@ -499,12 +500,12 @@ begin
.Chain<TEMA.TInput>(function(const Value: Double): TEMA.TInput begin Result.Price := Value end)
.Chain<TEMA.TResult>(EMAConv)
.Chain<Double>(function(const Value: TEMA.TResult): Double begin Result := Value.MA end);
*)
//////////////
panel := pnlChart.AddPanel;
panel.AddDoubleSeries(equity.Producer, TAlphaColors.Blue, 3);
panel.AddDoubleSeries(equityEMA, TAlphaColors.Gray, 2);
// panel.AddDoubleSeries(equityEMA, TAlphaColors.Gray, 2);
/////
end;
AuraTrader/StrategyTest.pas
+1 -1
View File
@@ -7,7 +7,7 @@ uses
Myc.Data.Pipeline,
Myc.Trade.Types,
Myc.Trade.Pipeline,
Myc.Trade.Indicators;
Myc.Trade.Indicators.Common;
function CreateStrategy1(Timeframe: TTimeframe): TConverter<TDataPoint<TOhlcItem>, Double>; overload;
AuraTrader/TestMethodCallFromRecordParams.pas
+137 -168
View File
@@ -2,40 +2,15 @@ unit TestMethodCallFromRecordParams;
interface
// We need RTTI here!
{$M+}
uses
System.Rtti,
System.SysUtils,
System.TypInfo,
System.Classes,
Myc.Data.Records;
Myc.Data.Records,
Myc.Trade.Indicators;
type
TIndicatorProc<TValue, TResult> = reference to function(const Value: TValue): TResult;
TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TIndicatorProc<TValue, TResult>;
IndicatorFactoryAttribute = class(TCustomAttribute);
TGenericIndicatorFactory = class
private
FParameterLayout: TDataRecord.TLayout;
FFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
public
constructor Create(
const AParameterLayout: TDataRecord.TLayout;
const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>
);
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
function CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
property ParameterLayout: TDataRecord.TLayout read FParameterLayout;
end;
TMyWorker = class
published
public
type
TParams = record
Log: Int64;
@@ -55,10 +30,34 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
end;
// SMA indicator for demonstration purposes
TSmaIndicator = class
public
type
TParams = record
Period: Integer;
end;
TArgs = record
Value: Double;
end;
TResult = record
Sma: Double;
end;
[IndicatorFactory]
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
end;
procedure Test1(const Log: TStrings);
procedure TestSma(const Log: TStrings);
implementation
uses
System.Math;
class function TMyWorker.CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>;
begin
Result :=
@@ -71,151 +70,12 @@ begin
function(const Args: TArgs): TResult
begin
// Use Format to avoid locale issues with float conversion
Log.Add(Format('Val=%f (...%s)', [Args.xyz, text]));
Log.Add(Format('Val=%f (...%s)', [Args.xyz, text]));
Result.desc := 'done';
end;
end;
end;
constructor TGenericIndicatorFactory.Create(
const AParameterLayout: TDataRecord.TLayout;
const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>
);
begin
inherited Create;
FParameterLayout := AParameterLayout;
FFactoryProc := AFactoryProc;
end;
class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
var
Ctx: TRttiContext;
rttiType: TRttiType;
templateFactoryMethod: TRttiMethod;
parameterLayout: TDataRecord.TLayout;
factoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
begin
// This function creates a generic factory from a template class (like TMyWorker).
// It uses RTTI to find the necessary types (TParams, TValue, TResult) and the
// factory method, and then constructs a set of wrappers to adapt the specific
// types of the template to the generic TDataRecord used by this factory.
Ctx := TRttiContext.Create;
rttiType := Ctx.GetType(TypeInfo(T));
// Find nested record types for parameters, values, and results.
var paramsType := Ctx.FindType(rttiType.QualifiedName + '.' + 'TParams');
if not Assigned(paramsType) then
raise EArgumentException.CreateFmt('TParams not found in "%s"', [rttiType.Name]);
var argsType := Ctx.FindType(rttiType.QualifiedName + '.' + 'TArgs');
if not Assigned(paramsType) then
raise EArgumentException.CreateFmt('TArgs not found in "%s"', [rttiType.Name]);
var resultType := Ctx.FindType(rttiType.QualifiedName + '.' + 'TResult');
if not Assigned(paramsType) then
raise EArgumentException.CreateFmt('TResult not found in "%s"', [rttiType.Name]);
// Find the static factory method marked with the [Factory] attribute.
templateFactoryMethod := nil;
for var method in rttiType.GetMethods do
begin
if method.HasAttribute<IndicatorFactoryAttribute> then
begin
templateFactoryMethod := method;
break;
end;
end;
if not Assigned(templateFactoryMethod) then
raise EArgumentException.CreateFmt('[Factory] attribute not found on any method in "%s"', [rttiType.Name]);
// Create the layout for the parameters, which will be exposed by this factory.
parameterLayout := TDataRecord.TLayout.FromRecord(paramsType.Handle);
// Create the main factory procedure. This is a double-nested anonymous method
// that wraps the template's specific factory and worker functions.
factoryProc :=
function(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>
var
// Capture the created worker proc from the original factory as a TValue to manage its lifetime.
workerProcAsValue: TValue;
begin
// Outer anonymous method: This is the factory proc.
// It gets called with a TDataRecord of parameters.
// 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
var factoryProcAsValue := templateFactoryMethod.Invoke(TValue.Empty, []);
// 2. Invoke the factory proc itself to get the actual worker proc.
var rttiFactoryProc := Ctx.GetType(factoryProcAsValue.TypeInfo) as TRttiInterfaceType;
var factoryInvokeMethod := rttiFactoryProc.GetMethod('Invoke');
// The parameter for this 'Invoke' call is the TParams record.
// Wrap the incoming TDataRecord 'Params' into a TValue for the call.
var factoryParamTypeInfo := factoryInvokeMethod.GetParameters[0].ParamType.Handle;
Assert(factoryParamTypeInfo = paramsType.Handle);
var factoryArg: array[0..0] of TValue;
TValue.Make(Params.RawData, factoryParamTypeInfo, factoryArg[0]);
// This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
workerProcAsValue := factoryInvokeMethod.Invoke(factoryProcAsValue, factoryArg);
// 3. Return a new anonymous method that wraps the worker proc.
// This wrapper conforms to the generic TIndicatorProc<TDataRecord, TDataRecord> signature.
var rttiWorkerProc := Ctx.GetType(workerProcAsValue.TypeInfo);
var indicatorInvokeMethod := rttiWorkerProc.GetMethod('Invoke');
var indicatorParamTypeInfo := indicatorInvokeMethod.GetParameters[0].ParamType.Handle;
var indicatorResultTypeInfo := indicatorInvokeMethod.ReturnType.Handle;
Assert(indicatorParamTypeInfo = argsType.Handle);
Assert(indicatorResultTypeInfo = resultType.Handle);
var valueLayout := TDataRecord.TLayout.FromRecord(indicatorParamTypeInfo);
var resultLayout := TDataRecord.TLayout.FromRecord(indicatorResultTypeInfo);
Result :=
function(const Value: TDataRecord): TDataRecord
begin
// Inner anonymous method: This is the actual indicator proc wrapper.
Assert(Value.Layout = valueLayout);
// Prepare argument for the worker proc invocation.
var args: array[0..0] of TValue;
TValue.MakeWithoutCopy(Value.RawData, indicatorParamTypeInfo, args[0], true);
// Invoke the actual worker proc.
var resultAsTValue := indicatorInvokeMethod.Invoke(workerProcAsValue, args);
// The result is a TValue containing the result record (e.g., TMyWorker.TResult).
// Copy its contents into a new TDataRecord to return it.
Assert(TDataRecord.TLayout.FromRecord(resultAsTValue.TypeInfo) = resultLayout);
Result := TDataRecord.Create(resultLayout);
var src := resultAsTValue.GetReferenceToRawData;
resultLayout.Copy(src, Result.RawData);
// Erase all raw data in the TValue, leaving it as an empty capsule. Ownership it taken
// over to the resulting TDataRecord.
FillChar(src^, resultLayout.Size, 0);
end;
end;
// Create the final factory instance with the generated layout and wrapper procedure.
Result := TGenericIndicatorFactory.Create(parameterLayout, factoryProc);
end;
function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
begin
// The factory proc does all the heavy lifting. We just need to call it.
// A real implementation might add checks, e.g., that the layout of Params matches.
Assert(
(not Assigned(FParameterLayout.Fields)) or (Params.Layout = FParameterLayout),
'Invalid parameter layout for indicator creation'
);
Result := FFactoryProc(Params);
end;
procedure Test1(const Log: TStrings);
begin
var fact := TGenericIndicatorFactory.CreateFromTemplate<TMyWorker>;
@@ -236,4 +96,113 @@ begin
Assert(desc = 'done');
end;
{ TSmaIndicator }
class function TSmaIndicator.CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>;
begin
Result :=
function(const Params: TParams): TIndicatorProc<TArgs, TResult>
var
// State for the indicator closure
period: Integer;
buffer: TArray<Double>;
sum: Double;
count: Integer;
idx: Integer;
begin
period := Params.Period;
if period <= 0 then
raise Exception.Create('Period must be positive');
SetLength(buffer, period);
sum := 0.0;
count := 0;
idx := 0;
Result :=
function(const Args: TArgs): TResult
begin
// If the buffer is full, subtract the oldest value that is about to be overwritten.
if count >= period then
sum := sum - buffer[idx];
// Add the new value to the buffer and the sum.
buffer[idx] := Args.Value;
sum := sum + Args.Value;
// Advance the index for the circular buffer.
idx := (idx + 1) mod period;
// Increment the fill count until the buffer is full for the first time.
if count < period then
inc(count);
// Calculate the SMA. The result is the average of the values currently in the buffer.
if count > 0 then
Result.Sma := sum / count
else
Result.Sma := 0.0;
end;
end;
end;
procedure TestSma(const Log: TStrings);
var
fact: TGenericIndicatorFactory;
params: TDataRecord;
indi: TIndicatorProc<TDataRecord, TDataRecord>;
args: TDataRecord;
res: TDataRecord;
smaValue: Double;
begin
Log.Add('');
Log.Add('--- Testing SMA ---');
fact := TGenericIndicatorFactory.CreateFromTemplate<TSmaIndicator>;
// 1. Setup indicator parameters.
params := TDataRecord.FromRecord<TSmaIndicator.TParams>;
params.SetValue<Integer>('Period', 3);
Log.Add(Format('Creating SMA with Period=%d', [params.GetValue<Integer>('Period')]));
// 2. Create the indicator instance.
indi := fact.CreateIndicator(params);
// 3. Create the arguments record (can be reused).
args := TDataRecord.FromRecord<TSmaIndicator.TArgs>;
// 4. Feed values and check results.
args.SetValue<Double>('Value', 10.0);
res := indi(args);
smaValue := res.GetValue<Double>('Sma');
Log.Add(Format('Input: 10.0 -> SMA: %f', [smaValue]));
Assert(SameValue(smaValue, 10.0)); // Avg of [10] is 10
args.SetValue<Double>('Value', 11.0);
res := indi(args);
smaValue := res.GetValue<Double>('Sma');
Log.Add(Format('Input: 11.0 -> SMA: %f', [smaValue]));
Assert(SameValue(smaValue, 10.5)); // Avg of [10, 11] is 10.5
args.SetValue<Double>('Value', 12.0);
res := indi(args);
smaValue := res.GetValue<Double>('Sma');
Log.Add(Format('Input: 12.0 -> SMA: %f', [smaValue]));
Assert(SameValue(smaValue, 11.0)); // Avg of [10, 11, 12] is 11
args.SetValue<Double>('Value', 13.0);
res := indi(args);
smaValue := res.GetValue<Double>('Sma');
Log.Add(Format('Input: 13.0 -> SMA: %f', [smaValue]));
Assert(SameValue(smaValue, 12.0)); // Avg of [11, 12, 13] is 12
args.SetValue<Double>('Value', 14.0);
res := indi(args);
smaValue := res.GetValue<Double>('Sma');
Log.Add(Format('Input: 14.0 -> SMA: %f', [smaValue]));
Assert(SameValue(smaValue, 13.0)); // Avg of [12, 13, 14] is 13
Log.Add('SMA test successful.');
end;
end.