Michael Schimmel
533 lines
18 KiB
ObjectPascal
533 lines
18 KiB
ObjectPascal
unit Myc.Trade.Indicators;
|
|
|
|
interface
|
|
|
|
{$M+}
|
|
|
|
uses
|
|
System.TypInfo,
|
|
System.Rtti,
|
|
Myc.Data.Pipeline,
|
|
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;
|
|
// The handle provides direct access to the type information of the field.
|
|
Handle: PTypeInfo;
|
|
end;
|
|
|
|
TFieldLayout = TArray<TFieldDef>;
|
|
|
|
// Interface for creating an indicator instance. Only contains functional aspects.
|
|
IIndicatorFactory = interface
|
|
function GetParamType: PTypeInfo;
|
|
function GetArgType: PTypeInfo;
|
|
function GetResultType: PTypeInfo;
|
|
|
|
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
|
|
|
|
// Provides direct access to the type information of parameters, arguments, and results.
|
|
property ParamType: PTypeInfo read GetParamType;
|
|
property ArgType: PTypeInfo read GetArgType;
|
|
property ResultType: PTypeInfo read GetResultType;
|
|
end;
|
|
|
|
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
|
|
private
|
|
FFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
|
|
FName: String;
|
|
FShortName: String;
|
|
FHint: String;
|
|
FParamType: PTypeInfo;
|
|
FArgType: PTypeInfo;
|
|
FResultType: PTypeInfo;
|
|
|
|
public
|
|
constructor Create(
|
|
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
|
|
const AShortName, AName, AHint: String;
|
|
const AParamType, AArgType, AResultType: PTypeInfo
|
|
);
|
|
|
|
// IIndicatorFactory
|
|
function GetParamType: PTypeInfo;
|
|
function GetArgType: PTypeInfo;
|
|
function GetResultType: PTypeInfo;
|
|
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>; 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;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils;
|
|
|
|
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<TValue, TValue, TValue>;
|
|
const AShortName, AName, AHint: String;
|
|
const AParamType, AArgType, AResultType: PTypeInfo
|
|
);
|
|
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;
|
|
paramsType, argsType, resultType: TRttiType;
|
|
templateFactoryMethod: TRttiMethod;
|
|
factoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
|
|
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 TValue 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;
|
|
|
|
// Get types from the now-validated factory method declaration.
|
|
paramsType := factoryInvoke.GetParameters[0].ParamType;
|
|
argsType := indicatorInvoke.GetParameters[0].ParamType;
|
|
resultType := indicatorInvoke.ReturnType;
|
|
Assert(paramsType.TypeKind = tkRecord);
|
|
Assert(argsType.TypeKind = tkRecord);
|
|
Assert(resultType.TypeKind = tkRecord);
|
|
|
|
// 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: TValue): TConvertFunc<TValue, TValue>
|
|
begin
|
|
// Outer anonymous method: This is the factory proc.
|
|
// It gets called with a TValue wrapping the parameters record.
|
|
|
|
// 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
|
|
var factoryProc := templateFactoryMethod.Invoke(TValue.Empty, []);
|
|
|
|
// 2. Invoke the factory proc itself to get the actual worker proc.
|
|
var rttiFactoryProc := Ctx.GetType(factoryProc.TypeInfo) as TRttiInterfaceType;
|
|
var currentFactoryInvoke := rttiFactoryProc.GetMethod('Invoke');
|
|
|
|
// The parameter for this 'Invoke' call is the TParams record.
|
|
// Wrap the incoming TValue 'Params' into a TValue for the call.
|
|
|
|
// This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
|
|
var workerProc := currentFactoryInvoke.Invoke(factoryProc, [Params]);
|
|
|
|
// 3. Return a new anonymous method that wraps the worker proc.
|
|
// This wrapper conforms to the generic TIndicatorProc<TValue, TValue> signature.
|
|
var rttiWorkerProc := Ctx.GetType(workerProc.TypeInfo);
|
|
var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke');
|
|
|
|
Result :=
|
|
function(const Args: TValue): TValue
|
|
begin
|
|
// Inner anonymous method: This is the actual indicator proc wrapper.
|
|
// Invoke the actual indicator proc.
|
|
Result := currentIndicatorInvoke.Invoke(workerProc, [Args]);
|
|
end;
|
|
end;
|
|
|
|
// Create the final factory instance with all type handles and extracted metadata.
|
|
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsType.Handle, argsType.Handle, resultType.Handle);
|
|
end;
|
|
|
|
function TGenericIndicatorFactory.GetParamType: PTypeInfo;
|
|
begin
|
|
Result := FParamType;
|
|
end;
|
|
|
|
function TGenericIndicatorFactory.GetArgType: PTypeInfo;
|
|
begin
|
|
Result := FArgType;
|
|
end;
|
|
|
|
function TGenericIndicatorFactory.GetResultType: PTypeInfo;
|
|
begin
|
|
Result := FResultType;
|
|
end;
|
|
|
|
function TGenericIndicatorFactory.CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
|
|
begin
|
|
Result := FFactoryProc(Params);
|
|
end;
|
|
|
|
function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
|
|
begin
|
|
var cIndicator := FFactoryProc(TValue.From<TParams>(Params));
|
|
Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From<TArgs>(Args)).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
|
|
var cIndicator := FFactory.CreateIndicator(TValue.From<TParams>(Params));
|
|
Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From<TArgs>(Args)).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 type information handle.
|
|
function LayoutFromTypeInfo(TypeInfo: PTypeInfo): TFieldLayout;
|
|
var
|
|
Ctx: TRttiContext;
|
|
rttiType: TRttiType;
|
|
rttiRecordType: TRttiRecordType;
|
|
field: TRttiField;
|
|
i: Integer;
|
|
begin
|
|
// This helper uses RTTI to inspect the record type and build the layout.
|
|
Ctx := TRttiContext.Create;
|
|
rttiType := Ctx.GetType(TypeInfo);
|
|
if not rttiType.IsRecord then
|
|
begin
|
|
SetLength(Result, 0);
|
|
exit;
|
|
end;
|
|
|
|
rttiRecordType := rttiType as TRttiRecordType;
|
|
var fields := rttiRecordType.GetFields;
|
|
SetLength(Result, Length(fields));
|
|
i := 0;
|
|
for field in fields do
|
|
begin
|
|
Result[i].Identifier := field.Name;
|
|
Result[i].Handle := field.FieldType.Handle;
|
|
Inc(i);
|
|
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.Handle.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', LayoutFromTypeInfo(item.Factory.ParamType));
|
|
LogLayout('Args', LayoutFromTypeInfo(item.Factory.ArgType));
|
|
LogLayout('Result', LayoutFromTypeInfo(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.
|