Indicator with new types

This commit is contained in:
Michael Schimmel
2025-08-25 18:30:02 +02:00
parent 947060566d
commit e329cbe598
3 changed files with 629 additions and 3 deletions
+1 -1
View File
@@ -8,7 +8,7 @@ uses
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',
Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas', Myc.Trade.Indicators_v2 in '..\Src\Myc.Trade.Indicators_v2.pas',
Strategy2 in 'Strategy2.pas'; Strategy2 in 'Strategy2.pas';
{$R *.res} {$R *.res}
+2 -2
View File
@@ -70,7 +70,7 @@
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon> <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<SanitizedProjectName>AuraTrader</SanitizedProjectName> <SanitizedProjectName>AuraTrader</SanitizedProjectName>
<DCC_UnitSearchPath>T:\Myc\Src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> <DCC_UnitSearchPath>T:\Myc\Src;T:\Myc\Src\Data;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Locale>1031</VerInfo_Locale> <VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup> </PropertyGroup>
@@ -138,7 +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="..\Src\Myc.Trade.Indicators.pas"/> <DCCReference Include="..\Src\Myc.Trade.Indicators_v2.pas"/>
<DCCReference Include="Strategy2.pas"/> <DCCReference Include="Strategy2.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
+626
View File
@@ -0,0 +1,626 @@
unit Myc.Trade.Indicators_V2;
interface
{$M+}
uses
System.TypInfo,
System.Rtti,
Myc.Data.Pipeline,
Myc.Data.Types,
System.Classes;
type
TIndicatorFactoryProc<TParams, TArgs, TResult> = reference to function(const Params: TParams): TConvertFunc<TArgs, TResult>;
(*
Sample definition of an indicator template:
type
[IndicatorName('HMA', 'Hull Moving Average')]
[IndicatorHint('A fast, smooth moving average that minimizes lag.')]
THMA = class
type
TParams = record
Period: Integer;
end;
TArgs = record
Value: Double;
end;
TResult = record
HMA: Double;
end;
[IndicatorFactory]
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
// Hard coded version:
class function CreateHMA( Period: Integer ): TConvertFunc<Double, Double>; static;
end;
*)
IndicatorFactoryAttribute = class(TCustomAttribute);
// Attribute to provide a short and a long name for an indicator.
IndicatorNameAttribute = class(TCustomAttribute)
private
FName: string;
FShortName: string;
public
constructor Create(const AShortName, AName: string);
property ShortName: string read FShortName;
property Name: string read FName;
end;
// Attribute to provide a descriptive hint for an indicator.
IndicatorHintAttribute = class(TCustomAttribute)
private
FHint: string;
public
constructor Create(const AHint: string);
property Hint: string read FHint;
end;
TFieldDef = record
public
Identifier: String;
// Use the custom type system instead of PTypeInfo.
DataType: IDataType;
end;
TFieldLayout = TArray<TFieldDef>;
// Interface for creating an indicator instance. Only contains functional aspects.
IIndicatorFactory = interface
function GetParamType: IDataType;
function GetArgType: IDataType;
function GetResultType: IDataType;
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>;
// Provides direct access to the type information of parameters, arguments, and results.
property ParamType: IDataType read GetParamType;
property ArgType: IDataType read GetArgType;
property ResultType: IDataType read GetResultType;
end;
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
private
FFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
FName: String;
FShortName: String;
FHint: String;
FParamType: IDataType;
FArgType: IDataType;
FResultType: IDataType;
public
constructor Create(
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
const AShortName, AName, AHint: String;
const AParamType, AArgType, AResultType: IDataType
);
// IIndicatorFactory
function GetParamType: IDataType;
function GetArgType: IDataType;
function GetResultType: IDataType;
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; overload;
property Name: String read FName;
property ShortName: String read FShortName;
property Hint: String read FHint;
end;
TIndicatorRegistry = class
public
// Represents a registered indicator, combining the factory with its metadata.
type
TItem = class
private
FFactory: IIndicatorFactory;
FName: string;
FShortName: string;
FHint: string;
public
constructor Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; overload;
property Factory: IIndicatorFactory read FFactory;
property Name: string read FName;
property ShortName: string read FShortName;
property Hint: string read FHint;
end;
private
FItems: TArray<TItem>;
public
constructor Create;
destructor Destroy; override;
// Writes the contents of the registry (just like the log)
procedure LogRegistry(const Log: TStrings);
// Register indicator from a template class
procedure RegisterTemplate<TIndicatorTemplate>;
// Register a pre-built indicator factory
procedure RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
// Find a registered factory by its short name
function Find(const ShortName: string): TItem;
// Provides read-only access to the list of all registered indicator items
property Items: TArray<TItem> read FItems;
end;
var
IndicatorRegistry: TIndicatorRegistry;
function DataValueFromTValue(const aValue: TValue): IDataValue;
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
implementation
uses
System.SysUtils;
// =================================================================================================
// == Helper functions for type conversion
// =================================================================================================
// Converts an RTTI type object into an IDataType from the custom type system.
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
begin
if not Assigned(rttiType) then
begin
Result := nil;
exit;
end;
case rttiType.TypeKind of
tkInteger, tkInt64, tkEnumeration: Result := TDataType.Ordinal;
tkFloat: Result := TDataType.Float;
tkString, tkUString: Result := TDataType.Text;
tkRecord:
begin
var rttiRecord := rttiType as TRttiRecordType;
var recordFields := TArray<TRecordField>.Create();
for var rttiField in rttiRecord.GetFields do
begin
var fieldType := DataTypeFromRttiType(Ctx, rttiField.FieldType);
recordFields := recordFields + [TRecordField.Create(rttiField.Name, fieldType)];
end;
Result := TDataType.RecordOf(recordFields);
end;
else
raise ENotSupportedException.CreateFmt(
'Unsupported RTTI TypeKind "%s" for indicator templates.',
[GetEnumName(TypeInfo(TTypeKind), Ord(rttiType.TypeKind))]);
end;
end;
// Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system.
function DataValueFromTValue(const aValue: TValue): IDataValue;
var
ctx: TRttiContext;
begin
if aValue.IsEmpty then
begin
Result := nil;
exit;
end;
case aValue.Kind of
tkInteger, tkInt64, tkEnumeration: Result := TDataValue.FromOrdinal(aValue.AsInt64);
tkFloat: Result := TDataValue.FromFloat(aValue.AsExtended);
tkString, tkUString: Result := TDataValue.FromText(aValue.AsString);
tkRecord:
begin
ctx := TRttiContext.Create;
var rttiRecordType := ctx.GetType(aValue.TypeInfo) as TRttiRecordType;
var recordDataType := DataTypeFromRttiType(ctx, rttiRecordType);
var items: TArray<IDataValue>;
var fields := rttiRecordType.GetFields;
SetLength(items, Length(fields));
var dataPtr := aValue.GetReferenceToRawData;
for var i := 0 to High(fields) do
items[i] := DataValueFromTValue(fields[i].GetValue(dataPtr));
Result := recordDataType.AsRecord.CreateValue(items);
end;
else
raise ENotSupportedException
.CreateFmt('Unsupported TValue Kind "%s" for indicator templates.', [GetEnumName(TypeInfo(TTypeKind), Ord(aValue.Kind))]);
end;
end;
constructor IndicatorNameAttribute.Create(const AShortName, AName: string);
begin
inherited Create;
FShortName := AShortName;
FName := AName;
end;
constructor IndicatorHintAttribute.Create(const AHint: string);
begin
inherited Create;
FHint := AHint;
end;
{ TGenericIndicatorFactory }
constructor TGenericIndicatorFactory.Create(
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
const AShortName, AName, AHint: String;
const AParamType, AArgType, AResultType: IDataType
);
begin
inherited Create;
FFactoryProc := AFactoryProc;
FShortName := AShortName;
FName := AName;
FHint := AHint;
FParamType := AParamType;
FArgType := AArgType;
FResultType := AResultType;
end;
class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
var
Ctx: TRttiContext;
rttiType: TRttiType;
paramsDataType, argsDataType, resultDataType: IDataType;
templateFactoryMethod: TRttiMethod;
factoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
shortName, name, hint: string;
begin
// This function creates a generic factory from a template class.
// It uses RTTI to find the necessary types by inspecting the factory method signature,
// and then constructs a set of wrappers to adapt the specific types of the template
// to the generic IDataValue used by this factory.
Ctx := TRttiContext.Create;
rttiType := Ctx.GetType(TypeInfo(T));
// Find the static factory method marked with the [IndicatorFactory] 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('[IndicatorFactory] attribute not found on any method in "%s"', [rttiType.Name]);
// Ensure the found method has the expected signature of a TIndicatorFactoryProc<>.
// If any part of the signature check fails, raise an exception.
var returnType := templateFactoryMethod.ReturnType;
var rttiFactoryProcType, rttiIndicatorProcType: TRttiInterfaceType;
var factoryInvoke, indicatorInvoke: TRttiMethod;
try
// Level 1: Factory method signature
if not ((templateFactoryMethod.MethodKind in [mkFunction, mkClassFunction])
and (Length(templateFactoryMethod.GetParameters) = 0)
and Assigned(returnType)
and (returnType.TypeKind = tkInterface)) then
raise EArgumentException.Create('factory creator');
// Level 2: Factory procedure signature
rttiFactoryProcType := returnType as TRttiInterfaceType;
factoryInvoke := rttiFactoryProcType.GetMethod('Invoke');
if not (Assigned(factoryInvoke)
and (Length(factoryInvoke.GetParameters) = 1)
and (pfConst in factoryInvoke.GetParameters[0].Flags)
and (factoryInvoke.GetParameters[0].ParamType.TypeKind = tkRecord)
and Assigned(factoryInvoke.ReturnType)
and (factoryInvoke.ReturnType.TypeKind = tkInterface)) then
raise EArgumentException.Create('factory');
// Level 3: Indicator procedure signature
rttiIndicatorProcType := factoryInvoke.ReturnType as TRttiInterfaceType;
indicatorInvoke := rttiIndicatorProcType.GetMethod('Invoke');
if not (Assigned(indicatorInvoke)
and (Length(indicatorInvoke.GetParameters) = 1)
and (pfConst in indicatorInvoke.GetParameters[0].Flags)
and (indicatorInvoke.GetParameters[0].ParamType.TypeKind = tkRecord)
and Assigned(indicatorInvoke.ReturnType)
and (indicatorInvoke.ReturnType.TypeKind = tkRecord)) then
raise EArgumentException.Create('indicator');
except
on E: EArgumentException do
raise EArgumentException.CreateFmt(
'Method "%s" marked with [IndicatorFactory] has an invalid %s signature. It has to match TIndicatorFactoryProc<>.',
[templateFactoryMethod.ToString, E.Message]);
end;
// Convert RTTI types to IDataType from our custom type system.
paramsDataType := DataTypeFromRttiType(Ctx, factoryInvoke.GetParameters[0].ParamType);
argsDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.GetParameters[0].ParamType);
resultDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.ReturnType);
// Extract metadata from attributes on the template type T.
shortName := '';
name := '';
hint := '';
for var attr in rttiType.GetAttributes do
begin
if attr is IndicatorNameAttribute then
begin
// Read properties from IndicatorNameAttribute.
var nameAttr := attr as IndicatorNameAttribute;
shortName := nameAttr.ShortName;
name := nameAttr.Name;
end
else if attr is IndicatorHintAttribute then
begin
// Read property from IndicatorHintAttribute.
var hintAttr := attr as IndicatorHintAttribute;
hint := hintAttr.Hint;
end;
end;
// Apply default value for ShortName if it wasn't provided via attribute.
if shortName.IsEmpty then
begin
shortName := rttiType.Name;
end;
// 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: IDataValue): TConvertFunc<IDataValue, IDataValue>
begin
// Outer anonymous method: This is the factory proc.
// It gets called with an IDataValue wrapping the parameters record.
// 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
var factoryProcVal := templateFactoryMethod.Invoke(TValue.Empty, []);
// 2. Invoke the factory proc itself to get the actual worker proc.
var rttiFactoryProc := Ctx.GetType(factoryProcVal.TypeInfo) as TRttiInterfaceType;
var currentFactoryInvoke := rttiFactoryProc.GetMethod('Invoke');
// The parameter for this 'Invoke' call is the TParams record.
// Convert incoming IDataValue 'Params' into a TValue for the call.
var paramsAsTValue := Params.AsTValue;
// This call returns the worker proc (e.g., a TConvertFunc<TArgs, TResult>) as a TValue.
var workerProcVal := currentFactoryInvoke.Invoke(factoryProcVal, [paramsAsTValue]);
// 3. Return a new anonymous method that wraps the worker proc.
// This wrapper conforms to the generic TConvertFunc<IDataValue, IDataValue> signature.
var rttiWorkerProc := Ctx.GetType(workerProcVal.TypeInfo);
var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke');
Result :=
function(const Args: IDataValue): IDataValue
begin
// Inner anonymous method: This is the actual indicator proc wrapper.
// Convert input from IDataValue to TValue.
var argsAsTValue := Args.AsTValue;
// Invoke the actual indicator proc.
var resultAsTValue := currentIndicatorInvoke.Invoke(workerProcVal, [argsAsTValue]);
// Convert result from TValue back to IDataValue.
Result := DataValueFromTValue(resultAsTValue);
end;
end;
// Create the final factory instance with all type handles and extracted metadata.
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType);
end;
function TGenericIndicatorFactory.GetParamType: IDataType;
begin
Result := FParamType;
end;
function TGenericIndicatorFactory.GetArgType: IDataType;
begin
Result := FArgType;
end;
function TGenericIndicatorFactory.GetResultType: IDataType;
begin
Result := FResultType;
end;
function TGenericIndicatorFactory.CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>;
begin
Result := FFactoryProc(Params);
end;
function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
begin
var paramsAsTValue := TValue.From<TParams>(Params);
var paramsAsDataValue := DataValueFromTValue(paramsAsTValue);
var cIndicator := FFactoryProc(paramsAsDataValue);
Result :=
function(const Args: TArgs): TResult
begin
var argsAsTValue := TValue.From<TArgs>(Args);
var argsAsDataValue := DataValueFromTValue(argsAsTValue);
var resultAsDataValue := cIndicator(argsAsDataValue);
var resultAsTValue := resultAsDataValue.AsTValue;
Result := resultAsTValue.AsType<TResult>;
end;
end;
{ TIndicatorRegistry.TItem }
constructor TIndicatorRegistry.TItem.Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
begin
inherited Create;
FFactory := AFactory;
FShortName := AShortName;
FName := AName;
FHint := AHint;
end;
function TIndicatorRegistry.TItem.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
begin
// Convert typed params to IDataValue for the factory call.
var paramsAsTValue := TValue.From<TParams>(Params);
var paramsAsDataValue := DataValueFromTValue(paramsAsTValue);
var cIndicator := FFactory.CreateIndicator(paramsAsDataValue);
// Return a wrapper that handles the conversion for args and result.
Result :=
function(const Args: TArgs): TResult
begin
var argsAsTValue := TValue.From<TArgs>(Args);
var argsAsDataValue := DataValueFromTValue(argsAsTValue);
var resultAsDataValue := cIndicator(argsAsDataValue);
var resultAsTValue := resultAsDataValue.AsTValue;
Result := resultAsTValue.AsType<TResult>;
end;
end;
{ TIndicatorRegistry }
constructor TIndicatorRegistry.Create;
begin
inherited;
FItems := nil;
end;
destructor TIndicatorRegistry.Destroy;
var
item: TItem;
begin
for item in FItems do
item.Free;
FItems := nil;
inherited;
end;
function TIndicatorRegistry.Find(const ShortName: string): TIndicatorRegistry.TItem;
begin
for var item in FItems do
begin
if SameText(item.ShortName, ShortName) then
begin
Result := item;
exit;
end;
end;
Result := nil;
end;
procedure TIndicatorRegistry.LogRegistry(const Log: TStrings);
var
item: TItem;
// Generates a field layout from a data type.
function LayoutFromDataType(DataType: IDataType): TFieldLayout;
var
recordType: IDataRecordType;
begin
if (not Assigned(DataType)) or (DataType.Kind <> TDataKind.dkRecord) then
begin
SetLength(Result, 0);
exit;
end;
recordType := TDataType.Create(DataType).AsRecord;
SetLength(Result, recordType.FieldCount);
for var i := 0 to recordType.FieldCount - 1 do
begin
Result[i].Identifier := recordType[i].Name;
Result[i].DataType := recordType[i].DataType;
end;
end;
procedure DoLog(const Txt: String);
begin
Log.Add(Txt);
end;
procedure LogLayout(const LayoutName: string; const Layout: TFieldLayout);
var
field: TFieldDef;
begin
DoLog(Format(' %s:', [LayoutName]));
if Length(Layout) = 0 then
begin
DoLog(' (none)');
end
else
begin
for field in Layout do
DoLog(Format(' - %s: %s', [field.Identifier, field.DataType.Name]));
end;
end;
begin
if not Assigned(Log) then
exit;
Log.Clear;
DoLog(Format('Indicator Registry Content (%d items)', [Length(FItems)]));
DoLog('==========================================');
DoLog('');
if Length(FItems) = 0 then
begin
DoLog('(Registry is empty)');
exit;
end;
for item in FItems do
begin
DoLog(Format('Indicator "%s" (%s)', [item.Name, item.ShortName]));
if not item.Hint.IsEmpty then
DoLog(Format(' Hint: %s', [item.Hint]));
// Generate layouts on-the-fly from the factory's type info.
LogLayout('Params', LayoutFromDataType(item.Factory.ParamType));
LogLayout('Args', LayoutFromDataType(item.Factory.ArgType));
LogLayout('Result', LayoutFromDataType(item.Factory.ResultType));
DoLog('');
end;
end;
procedure TIndicatorRegistry.RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
var
item: TItem;
begin
if Assigned(Find(ShortName)) then
raise EArgumentException.CreateFmt('Indicator with ShortName "%s" is already registered.', [ShortName]);
// Create the registry item and add it to the list.
item := TItem.Create(Factory, ShortName, Name, Hint);
var i := Length(FItems);
SetLength(FItems, i + 1);
FItems[i] := item;
end;
procedure TIndicatorRegistry.RegisterTemplate<TIndicatorTemplate>;
begin
// Create the factory object, which holds both the factory interface and the metadata properties.
var factory := TGenericIndicatorFactory.CreateFromTemplate<TIndicatorTemplate>;
// Pass the factory interface and the metadata properties to the core registration method.
RegisterIndicator(factory, factory.ShortName, factory.Name, factory.Hint);
end;
initialization
IndicatorRegistry := TIndicatorRegistry.Create;
finalization
IndicatorRegistry.Free;
end.