From e329cbe598d71a3b2d1dd62e497de963a7073c26 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 25 Aug 2025 18:30:02 +0200 Subject: [PATCH] Indicator with new types --- AuraTrader/AuraTrader.dpr | 2 +- AuraTrader/AuraTrader.dproj | 4 +- Src/Myc.Trade.Indicators_v2.pas | 626 ++++++++++++++++++++++++++++++++ 3 files changed, 629 insertions(+), 3 deletions(-) create mode 100644 Src/Myc.Trade.Indicators_v2.pas diff --git a/AuraTrader/AuraTrader.dpr b/AuraTrader/AuraTrader.dpr index 079bf73..0c6aa76 100644 --- a/AuraTrader/AuraTrader.dpr +++ b/AuraTrader/AuraTrader.dpr @@ -8,7 +8,7 @@ uses TestModule in 'TestModule.pas', DynamicFMXControl in 'DynamicFMXControl.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'; {$R *.res} diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj index 9c1c642..b476b63 100644 --- a/AuraTrader/AuraTrader.dproj +++ b/AuraTrader/AuraTrader.dproj @@ -70,7 +70,7 @@ $(BDS)\bin\delphi_PROJECTICON.ico $(BDS)\bin\delphi_PROJECTICNS.icns AuraTrader - T:\Myc\Src;$(DCC_UnitSearchPath) + T:\Myc\Src;T:\Myc\Src\Data;$(DCC_UnitSearchPath) 1031 CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= @@ -138,7 +138,7 @@ - + Base diff --git a/Src/Myc.Trade.Indicators_v2.pas b/Src/Myc.Trade.Indicators_v2.pas new file mode 100644 index 0000000..4893f34 --- /dev/null +++ b/Src/Myc.Trade.Indicators_v2.pas @@ -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 = reference to function(const Params: TParams): TConvertFunc; + + (* + 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; static; + + // Hard coded version: + class function CreateHMA( Period: Integer ): TConvertFunc; 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; + + // 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; + + // 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; + FName: String; + FShortName: String; + FHint: String; + FParamType: IDataType; + FArgType: IDataType; + FResultType: IDataType; + + public + constructor Create( + const AFactoryProc: TIndicatorFactoryProc; + 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; overload; + + class function CreateFromTemplate: TGenericIndicatorFactory; + + function CreateIndicator(const Params: TParams): TConvertFunc; 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(const Params: TParams): TConvertFunc; 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; + + 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; + + // 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 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.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; + 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; + 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: TGenericIndicatorFactory; +var + Ctx: TRttiContext; + rttiType: TRttiType; + paramsDataType, argsDataType, resultDataType: IDataType; + templateFactoryMethod: TRttiMethod; + factoryProc: TIndicatorFactoryProc; + 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 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 + 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) 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 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; +begin + Result := FFactoryProc(Params); +end; + +function TGenericIndicatorFactory.CreateIndicator(const Params: TParams): TConvertFunc; +begin + var paramsAsTValue := TValue.From(Params); + var paramsAsDataValue := DataValueFromTValue(paramsAsTValue); + var cIndicator := FFactoryProc(paramsAsDataValue); + + Result := + function(const Args: TArgs): TResult + begin + var argsAsTValue := TValue.From(Args); + var argsAsDataValue := DataValueFromTValue(argsAsTValue); + var resultAsDataValue := cIndicator(argsAsDataValue); + var resultAsTValue := resultAsDataValue.AsTValue; + Result := resultAsTValue.AsType; + 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(const Params: TParams): TConvertFunc; +begin + // Convert typed params to IDataValue for the factory call. + var paramsAsTValue := TValue.From(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(Args); + var argsAsDataValue := DataValueFromTValue(argsAsTValue); + var resultAsDataValue := cIndicator(argsAsDataValue); + var resultAsTValue := resultAsDataValue.AsTValue; + Result := resultAsTValue.AsType; + 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; +begin + // Create the factory object, which holds both the factory interface and the metadata properties. + var factory := TGenericIndicatorFactory.CreateFromTemplate; + // 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.