Generic indicator factory
This commit is contained in:
Michael Schimmel
+392
-467
@@ -3,537 +3,462 @@ unit Myc.Trade.Indicators;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Math,
|
||||
System.Generics.Collections,
|
||||
System.Rtti,
|
||||
Myc.Data.Records,
|
||||
Myc.Data.Pipeline,
|
||||
Myc.Data.Series,
|
||||
Myc.Trade.Types;
|
||||
Myc.Data.Records;
|
||||
|
||||
{$M+}
|
||||
|
||||
type
|
||||
// Result for the Moving Average Convergence Divergence (MACD) indicator.
|
||||
TMacdResult = record
|
||||
MacdLine: Double;
|
||||
SignalLine: Double;
|
||||
Histogram: Double;
|
||||
end;
|
||||
TIndicatorProc<TValue, TResult> = reference to function(const Value: TValue): TResult;
|
||||
TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TIndicatorProc<TValue, TResult>;
|
||||
|
||||
// Result for the Stochastic Oscillator indicator.
|
||||
TStochasticResult = record
|
||||
K: Double; // %K line
|
||||
D: Double; // %D line (signal line)
|
||||
end;
|
||||
(*
|
||||
Sample definition of an indicator template:
|
||||
|
||||
// Result for the Bollinger Bands indicator.
|
||||
TBollingerBandsResult = record
|
||||
UpperBand: Double;
|
||||
MiddleBand: Double;
|
||||
LowerBand: Double;
|
||||
end;
|
||||
type
|
||||
[IndicatorName('HMA', 'Hull Moving Average')]
|
||||
[IndicatorHint('A fast, smooth moving average that minimizes lag.')]
|
||||
THMA = class
|
||||
type
|
||||
TParams = record
|
||||
Period: Integer;
|
||||
end;
|
||||
|
||||
// Result for the Keltner Channels indicator.
|
||||
TKeltnerChannelsResult = record
|
||||
UpperBand: Double;
|
||||
MiddleBand: Double;
|
||||
LowerBand: Double;
|
||||
end;
|
||||
TArgs = record
|
||||
Value: Double;
|
||||
end;
|
||||
|
||||
TIndicators = record
|
||||
TResult = record
|
||||
HMA: Double;
|
||||
end;
|
||||
|
||||
[IndicatorFactory]
|
||||
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
|
||||
end;
|
||||
*)
|
||||
|
||||
IndicatorFactoryAttribute = class(TCustomAttribute);
|
||||
|
||||
// Attribute to provide a short and a long name for an indicator.
|
||||
IndicatorNameAttribute = class(TCustomAttribute)
|
||||
private
|
||||
class function CalculateSMA(const Series: TSeries<Double>; const Period: Integer): Double; static;
|
||||
class function CalculateStdDev(const Series: TSeries<Double>; const Period: Integer): Double; static;
|
||||
class function CalculateWMA(const Series: TSeries<Double>; const Period: Integer): Double; static;
|
||||
FName: string;
|
||||
FShortName: string;
|
||||
public
|
||||
// Simple Moving Average
|
||||
class function CreateSMA(Period: Integer): TConvertFunc<Double, Double>; static;
|
||||
// Exponential Moving Average
|
||||
class function CreateEMA(Period: Integer): TConvertFunc<Double, Double>; static;
|
||||
// Hull Moving Average
|
||||
class function CreateHMA(Period: Integer): TConvertFunc<Double, Double>; static;
|
||||
// Relative Strength Index
|
||||
class function CreateRSI(Period: Integer): TConvertFunc<Double, Double>; static;
|
||||
// Moving Average Convergence Divergence
|
||||
class function CreateMACD(FastPeriod, SlowPeriod, SignalPeriod: Integer): TConvertFunc<Double, TMacdResult>; overload; static;
|
||||
class function CreateMACD(
|
||||
const EmaFast,
|
||||
EmaSlow,
|
||||
EmaSignal: TConvertFunc<Double, Double>
|
||||
): TConvertFunc<Double, TMacdResult>; overload; static;
|
||||
// Stochastic Oscillator
|
||||
class function CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc<TOhlcItem, TStochasticResult>; overload; static;
|
||||
class function CreateStochastic(
|
||||
KPeriod: Integer;
|
||||
const SmaD: TConvertFunc<Double, Double>
|
||||
): TConvertFunc<TOhlcItem, TStochasticResult>; overload; static;
|
||||
// Bollinger Bands
|
||||
class function CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc<Double, TBollingerBandsResult>; static;
|
||||
// Average True Range
|
||||
class function CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>; overload; static;
|
||||
class function CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>; overload; static;
|
||||
// Keltner Channels
|
||||
class function CreateKeltnerChannels(
|
||||
Period: Integer;
|
||||
Multiplier: Double
|
||||
): TConvertFunc<TOhlcItem, TKeltnerChannelsResult>; overload; static;
|
||||
class function CreateKeltnerChannels(
|
||||
const MovAvgMiddle: TConvertFunc<Double, Double>;
|
||||
const AtrFunc: TConvertFunc<TOhlcItem, Double>;
|
||||
Multiplier: Double
|
||||
): TConvertFunc<TOhlcItem, TKeltnerChannelsResult>; overload; static;
|
||||
|
||||
class function CreateMean: TConvertFunc<TArray<Double>, Double>; static;
|
||||
constructor Create(const AShortName, AName: string);
|
||||
property ShortName: string read FShortName;
|
||||
property Name: string read FName;
|
||||
end;
|
||||
|
||||
TEMA = class
|
||||
// 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;
|
||||
|
||||
// Interface for creating an indicator instance. Only contains functional aspects.
|
||||
IIndicatorFactory = interface
|
||||
{$region 'private'}
|
||||
function GetArgumentLayout: TDataRecord.TLayout;
|
||||
function GetParameterLayout: TDataRecord.TLayout;
|
||||
function GetResultLayout: TDataRecord.TLayout;
|
||||
{$endregion}
|
||||
|
||||
function CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
|
||||
|
||||
property ParameterLayout: TDataRecord.TLayout read GetParameterLayout;
|
||||
property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout;
|
||||
property ResultLayout: TDataRecord.TLayout read GetResultLayout;
|
||||
end;
|
||||
|
||||
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
|
||||
private
|
||||
FParameterLayout: TDataRecord.TLayout;
|
||||
FFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
|
||||
FName: String;
|
||||
FArgumentLayout: TDataRecord.TLayout;
|
||||
FResultLayout: TDataRecord.TLayout;
|
||||
FShortName: String;
|
||||
FHint: String;
|
||||
function GetArgumentLayout: TDataRecord.TLayout;
|
||||
function GetParameterLayout: TDataRecord.TLayout;
|
||||
function GetResultLayout: TDataRecord.TLayout;
|
||||
public
|
||||
constructor Create(
|
||||
const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout;
|
||||
const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
|
||||
const AShortName, AName, AHint: String
|
||||
);
|
||||
|
||||
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
|
||||
|
||||
function CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
|
||||
|
||||
property ParameterLayout: TDataRecord.TLayout read GetParameterLayout;
|
||||
property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout;
|
||||
property ResultLayout: TDataRecord.TLayout read GetResultLayout;
|
||||
|
||||
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
|
||||
TParam = record
|
||||
Period: Integer;
|
||||
TItem = class
|
||||
private
|
||||
FFactory: IIndicatorFactory;
|
||||
FName: string;
|
||||
FShortName: string;
|
||||
FHint: string;
|
||||
public
|
||||
constructor Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
|
||||
property Factory: IIndicatorFactory read FFactory;
|
||||
property Name: string read FName;
|
||||
property ShortName: string read FShortName;
|
||||
property Hint: string read FHint;
|
||||
end;
|
||||
|
||||
TInput = record
|
||||
Price: Double;
|
||||
end;
|
||||
|
||||
TResult = record
|
||||
MA: Double;
|
||||
end;
|
||||
|
||||
private
|
||||
FItems: TArray<TItem>;
|
||||
public
|
||||
class function CreateEMA(const Param: TParam): TConvertFunc<TInput, TResult>; static;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
// 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
|
||||
Registry: TIndicatorRegistry;
|
||||
|
||||
implementation
|
||||
|
||||
{ TIndicators }
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.TypInfo,
|
||||
System.Rtti;
|
||||
|
||||
class function TIndicators.CalculateSMA(const Series: TSeries<Double>; const Period: Integer): Double;
|
||||
var
|
||||
i: Integer;
|
||||
sum: Double;
|
||||
constructor IndicatorNameAttribute.Create(const AShortName, AName: string);
|
||||
begin
|
||||
if (Series.Count < Period) or (Period <= 0) then
|
||||
Exit(0.0);
|
||||
|
||||
sum := 0;
|
||||
for i := 0 to Period - 1 do
|
||||
sum := sum + Series[i];
|
||||
|
||||
Result := sum / Period;
|
||||
inherited Create;
|
||||
FShortName := AShortName;
|
||||
FName := AName;
|
||||
end;
|
||||
|
||||
class function TIndicators.CalculateStdDev(const Series: TSeries<Double>; const Period: Integer): Double;
|
||||
var
|
||||
i: Integer;
|
||||
mean, sumOfSquares: Double;
|
||||
constructor IndicatorHintAttribute.Create(const AHint: string);
|
||||
begin
|
||||
if (Series.Count < Period) or (Period <= 0) then
|
||||
Exit(0.0);
|
||||
|
||||
mean := CalculateSMA(Series, Period);
|
||||
sumOfSquares := 0;
|
||||
for i := 0 to Period - 1 do
|
||||
sumOfSquares := sumOfSquares + Power(Series[i] - mean, 2);
|
||||
|
||||
Result := Sqrt(sumOfSquares / Period);
|
||||
inherited Create;
|
||||
FHint := AHint;
|
||||
end;
|
||||
|
||||
class function TIndicators.CalculateWMA(const Series: TSeries<Double>; const Period: Integer): Double;
|
||||
var
|
||||
i: Integer;
|
||||
numerator: Double;
|
||||
denominator: Int64;
|
||||
{ TGenericIndicatorFactory }
|
||||
|
||||
constructor TGenericIndicatorFactory.Create(
|
||||
const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout;
|
||||
const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
|
||||
const AShortName, AName, AHint: String
|
||||
);
|
||||
begin
|
||||
// Ensure there is enough data to calculate the WMA
|
||||
if (Series.Count < Period) or (Period <= 0) then
|
||||
Exit(0.0);
|
||||
inherited Create;
|
||||
FParameterLayout := AParameterLayout;
|
||||
FArgumentLayout := AArgumentLayout;
|
||||
FResultLayout := AResultLayout;
|
||||
FFactoryProc := AFactoryProc;
|
||||
FShortName := AShortName;
|
||||
FName := AName;
|
||||
FHint := AHint;
|
||||
end;
|
||||
|
||||
numerator := 0;
|
||||
// The sum of weights (1 + 2 + ... + Period)
|
||||
denominator := Period * (Period + 1) div 2;
|
||||
class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
|
||||
var
|
||||
Ctx: TRttiContext;
|
||||
rttiType: TRttiType;
|
||||
paramsType, argsType, resultType: TRttiType;
|
||||
templateFactoryMethod: TRttiMethod;
|
||||
parameterLayout, argumentLayout, resultLayout: TDataRecord.TLayout;
|
||||
factoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
|
||||
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 TDataRecord used by this factory.
|
||||
Ctx := TRttiContext.Create;
|
||||
rttiType := Ctx.GetType(TypeInfo(T));
|
||||
|
||||
if (denominator = 0) then
|
||||
Exit(0.0);
|
||||
|
||||
for i := 0 to Period - 1 do
|
||||
// Find the static factory method marked with the [IndicatorFactory] attribute.
|
||||
templateFactoryMethod := nil;
|
||||
for var method in rttiType.GetMethods do
|
||||
begin
|
||||
// Newest data (index 0) gets the highest weight (Period)
|
||||
numerator := numerator + Series[i] * (Period - i);
|
||||
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;
|
||||
|
||||
Result := numerator / denominator;
|
||||
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);
|
||||
|
||||
class function TIndicators.CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc<Double, TBollingerBandsResult>;
|
||||
begin
|
||||
var sourceData: TSeries<Double>;
|
||||
Result :=
|
||||
function(const Value: Double): TBollingerBandsResult
|
||||
var
|
||||
stdDev: Double;
|
||||
// Create the layouts for parameters, arguments, and results.
|
||||
parameterLayout := TDataRecord.TLayout.FromRecord(paramsType.Handle);
|
||||
argumentLayout := TDataRecord.TLayout.FromRecord(argsType.Handle);
|
||||
resultLayout := TDataRecord.TLayout.FromRecord(resultType.Handle);
|
||||
|
||||
// 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
|
||||
sourceData.Add(Value, Period);
|
||||
Result.MiddleBand := Double.NaN;
|
||||
Result.UpperBand := Double.NaN;
|
||||
Result.LowerBand := Double.NaN;
|
||||
|
||||
if (sourceData.Count >= Period) then
|
||||
begin
|
||||
Result.MiddleBand := CalculateSMA(sourceData, Period);
|
||||
stdDev := CalculateStdDev(sourceData, Period);
|
||||
Result.UpperBand := Result.MiddleBand + (stdDev * Multiplier);
|
||||
Result.LowerBand := Result.MiddleBand - (stdDev * Multiplier);
|
||||
end;
|
||||
// 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;
|
||||
end;
|
||||
|
||||
class function TIndicators.CreateEMA(Period: Integer): TConvertFunc<Double, Double>;
|
||||
begin
|
||||
var lastEma: Double := Double.NaN;
|
||||
var sourceData: TSeries<Double>;
|
||||
var multiplier := 2 / (Period + 1);
|
||||
// Apply default value for ShortName if it wasn't provided via attribute.
|
||||
if shortName.IsEmpty then
|
||||
begin
|
||||
shortName := rttiType.Name;
|
||||
end;
|
||||
|
||||
Result :=
|
||||
function(const Value: Double): Double
|
||||
// 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>
|
||||
begin
|
||||
sourceData.Add(Value, Period);
|
||||
// Outer anonymous method: This is the factory proc.
|
||||
// It gets called with a TDataRecord of parameters.
|
||||
|
||||
if (sourceData.Count < Period) then
|
||||
begin
|
||||
Result := Double.NaN;
|
||||
Exit;
|
||||
end;
|
||||
// 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
|
||||
var factoryProcAsValue := templateFactoryMethod.Invoke(TValue.Empty, []);
|
||||
|
||||
if not IsNan(lastEma) then
|
||||
begin
|
||||
// Subsequent EMA calculation
|
||||
lastEma := (Value - lastEma) * multiplier + lastEma;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// First EMA is a SMA of the initial period
|
||||
lastEma := CalculateSMA(sourceData, Period);
|
||||
end;
|
||||
Result := lastEma;
|
||||
end;
|
||||
end;
|
||||
// 2. Invoke the factory proc itself to get the actual worker proc.
|
||||
var rttiFactoryProc := Ctx.GetType(factoryProcAsValue.TypeInfo) as TRttiInterfaceType;
|
||||
var currentFactoryInvoke := rttiFactoryProc.GetMethod('Invoke');
|
||||
|
||||
class function TIndicators.CreateHMA(Period: Integer): TConvertFunc<Double, Double>;
|
||||
begin
|
||||
var periodHalf := Period div 2;
|
||||
var periodSqrt := Round(Sqrt(Period));
|
||||
var sourceData: TSeries<Double>;
|
||||
var diffSeries: TSeries<Double>;
|
||||
// The parameter for this 'Invoke' call is the TParams record.
|
||||
// Wrap the incoming TDataRecord 'Params' into a TValue for the call.
|
||||
var factoryParamTypeInfo := currentFactoryInvoke.GetParameters[0].ParamType.Handle;
|
||||
Assert(factoryParamTypeInfo = paramsType.Handle);
|
||||
|
||||
Result :=
|
||||
function(const Value: Double): Double
|
||||
var
|
||||
price: Double;
|
||||
wmaHalf, wmaFull, diff: Double;
|
||||
begin
|
||||
price := Value;
|
||||
var factoryArg: array[0..0] of TValue;
|
||||
TValue.Make(Params.RawData, factoryParamTypeInfo, factoryArg[0]);
|
||||
|
||||
// Default HMA to NaN for the warm-up period.
|
||||
Result := Double.NaN;
|
||||
// This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
|
||||
var workerProcAsValue := currentFactoryInvoke.Invoke(factoryProcAsValue, factoryArg);
|
||||
|
||||
// Add new price to the source data array, respecting the lookback period.
|
||||
sourceData.Add(price, Period);
|
||||
// 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 currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke');
|
||||
var indicatorParamTypeInfo := currentIndicatorInvoke.GetParameters[0].ParamType.Handle;
|
||||
|
||||
// Check if there is enough data to start the first stage of calculation.
|
||||
if (sourceData.Count >= Period) then
|
||||
begin
|
||||
// Calculate the two WMAs for the first step.
|
||||
wmaHalf := CalculateWMA(sourceData, periodHalf);
|
||||
wmaFull := CalculateWMA(sourceData, Period);
|
||||
|
||||
// Calculate the difference and add to the intermediate series.
|
||||
diff := 2 * wmaHalf - wmaFull;
|
||||
diffSeries.Add(diff, periodSqrt);
|
||||
|
||||
// Check if there is enough intermediate data for the final calculation.
|
||||
if (diffSeries.Count >= periodSqrt) then
|
||||
Result :=
|
||||
function(const Args: TDataRecord): TDataRecord
|
||||
begin
|
||||
// Calculate the final HMA value
|
||||
Result := CalculateWMA(diffSeries, periodSqrt);
|
||||
// Sadly, it's not possible to inject a buffer into a TValue. So we need to copy both Args and Result.
|
||||
|
||||
// Inner anonymous method: This is the actual indicator proc wrapper.
|
||||
// The layouts are captured from the outer scope.
|
||||
Assert(Args.Layout = argumentLayout);
|
||||
|
||||
// Prepare argument for the indicator proc invocation.
|
||||
// TValue just carries the data, ownership is held by the caller.
|
||||
var argVal: array[0..0] of TValue;
|
||||
TValue.MakeWithoutCopy(Args.RawData, indicatorParamTypeInfo, argVal[0], true);
|
||||
|
||||
// Invoke the actual indicator proc.
|
||||
var resultAsTValue := currentIndicatorInvoke.Invoke(workerProcAsValue, argVal);
|
||||
|
||||
// The result is a TValue containing the result record.
|
||||
// Raw copy and erase all data from the TValue, leaving it as an empty capsule. Ownership is taken
|
||||
// over to the resulting TDataRecord. This works because the memory layouts are exactly the same.
|
||||
Assert(TDataRecord.TLayout.FromRecord(resultAsTValue.TypeInfo) = resultLayout);
|
||||
|
||||
var buf: TBytes;
|
||||
var resultSize := resultLayout.Size;
|
||||
SetLength(buf, resultSize);
|
||||
|
||||
var src := resultAsTValue.GetReferenceToRawData;
|
||||
Move(src^, buf[0], resultSize);
|
||||
FillChar(src^, resultSize, 0);
|
||||
|
||||
Result.Create(resultLayout, buf);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Create the final factory instance with all layouts and extracted metadata.
|
||||
Result := TGenericIndicatorFactory.Create(parameterLayout, argumentLayout, resultLayout, factoryProc, shortName, name, hint);
|
||||
end;
|
||||
|
||||
// Standard MACD using EMAs.
|
||||
class function TIndicators.CreateMACD(FastPeriod, SlowPeriod, SignalPeriod: Integer): TConvertFunc<Double, TMacdResult>;
|
||||
function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
|
||||
begin
|
||||
Result := CreateMACD(CreateEMA(FastPeriod), CreateEMA(SlowPeriod), CreateEMA(SignalPeriod));
|
||||
Assert(
|
||||
(not Assigned(FParameterLayout.Fields)) or (Params.Layout = FParameterLayout),
|
||||
'Invalid parameter layout for indicator creation'
|
||||
);
|
||||
Result := FFactoryProc(Params);
|
||||
end;
|
||||
|
||||
// Creates a MACD indicator from three provided moving average functions.
|
||||
class function TIndicators.CreateMACD(const EmaFast, EmaSlow, EmaSignal: TConvertFunc<Double, Double>): TConvertFunc<Double, TMacdResult>;
|
||||
function TGenericIndicatorFactory.GetArgumentLayout: TDataRecord.TLayout;
|
||||
begin
|
||||
Result :=
|
||||
function(const Value: Double): TMacdResult
|
||||
var
|
||||
fastVal, slowVal: Double;
|
||||
Result := FArgumentLayout;
|
||||
end;
|
||||
|
||||
function TGenericIndicatorFactory.GetParameterLayout: TDataRecord.TLayout;
|
||||
begin
|
||||
Result := FParameterLayout;
|
||||
end;
|
||||
|
||||
function TGenericIndicatorFactory.GetResultLayout: TDataRecord.TLayout;
|
||||
begin
|
||||
Result := FResultLayout;
|
||||
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;
|
||||
|
||||
{ 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
|
||||
fastVal := EmaFast(Value);
|
||||
slowVal := EmaSlow(Value);
|
||||
|
||||
if IsNan(slowVal) then // slowVal will be the last one to become non-NaN
|
||||
begin
|
||||
Result.MacdLine := Double.NaN;
|
||||
Result.SignalLine := Double.NaN;
|
||||
Result.Histogram := Double.NaN;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result.MacdLine := fastVal - slowVal;
|
||||
Result.SignalLine := EmaSignal(Result.MacdLine);
|
||||
if not IsNan(Result.SignalLine) then
|
||||
Result.Histogram := Result.MacdLine - Result.SignalLine
|
||||
else
|
||||
Result.Histogram := Double.NaN;
|
||||
end;
|
||||
Result := item;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
class function TIndicators.CreateRSI(Period: Integer): TConvertFunc<Double, Double>;
|
||||
procedure TIndicatorRegistry.RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
|
||||
var
|
||||
item: TItem;
|
||||
begin
|
||||
var avgGain: Double := Double.NaN;
|
||||
var avgLoss: Double := Double.NaN;
|
||||
var sourceData: TSeries<Double>;
|
||||
if not Assigned(Factory) then
|
||||
raise EArgumentException.Create('Factory');
|
||||
|
||||
Result :=
|
||||
function(const Value: Double): Double
|
||||
var
|
||||
change, gain, loss, rs: Double;
|
||||
gainSum, lossSum: Double;
|
||||
i: Integer;
|
||||
begin
|
||||
sourceData.Add(Value, Period + 1);
|
||||
Result := Double.NaN;
|
||||
if Assigned(Find(ShortName)) then
|
||||
raise EArgumentException.CreateFmt('Indicator with ShortName "%s" is already registered.', [ShortName]);
|
||||
|
||||
if (sourceData.Count <= Period) then
|
||||
Exit;
|
||||
|
||||
// Initial calculation for the first full period
|
||||
if IsNan(avgGain) then
|
||||
begin
|
||||
gainSum := 0;
|
||||
lossSum := 0;
|
||||
for i := 0 to Period - 1 do
|
||||
begin
|
||||
change := sourceData[i] - sourceData[i + 1];
|
||||
if (change > 0) then
|
||||
gainSum := gainSum + change
|
||||
else
|
||||
lossSum := lossSum - change;
|
||||
end;
|
||||
avgGain := gainSum / Period;
|
||||
avgLoss := lossSum / Period;
|
||||
end
|
||||
else // Smoothed calculation for subsequent values
|
||||
begin
|
||||
change := sourceData[0] - sourceData[1];
|
||||
gain := 0;
|
||||
loss := 0;
|
||||
if (change > 0) then
|
||||
gain := change
|
||||
else
|
||||
loss := -change;
|
||||
|
||||
avgGain := (avgGain * (Period - 1) + gain) / Period;
|
||||
avgLoss := (avgLoss * (Period - 1) + loss) / Period;
|
||||
end;
|
||||
|
||||
if (avgLoss = 0) then
|
||||
Result := 100
|
||||
else
|
||||
begin
|
||||
rs := avgGain / avgLoss;
|
||||
Result := 100 - (100 / (1 + rs));
|
||||
end;
|
||||
end;
|
||||
// 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;
|
||||
|
||||
class function TIndicators.CreateSMA(Period: Integer): TConvertFunc<Double, Double>;
|
||||
procedure TIndicatorRegistry.RegisterTemplate<TIndicatorTemplate>;
|
||||
begin
|
||||
var sourceData: TSeries<Double>;
|
||||
Result :=
|
||||
function(const Value: Double): Double
|
||||
begin
|
||||
sourceData.Add(Value, Period);
|
||||
if (sourceData.Count >= Period) then
|
||||
Result := CalculateSMA(sourceData, Period)
|
||||
else
|
||||
Result := Double.NaN;
|
||||
end;
|
||||
// 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;
|
||||
|
||||
// Standard Stochastic Oscillator using an SMA for the %D line.
|
||||
class function TIndicators.CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc<TOhlcItem, TStochasticResult>;
|
||||
begin
|
||||
Result := CreateStochastic(KPeriod, CreateSMA(DPeriod));
|
||||
end;
|
||||
initialization
|
||||
Registry := TIndicatorRegistry.Create;
|
||||
|
||||
// Creates a Stochastic Oscillator using an injectable moving average for the %D line.
|
||||
class function TIndicators.CreateStochastic(
|
||||
KPeriod: Integer;
|
||||
const SmaD: TConvertFunc<Double, Double>
|
||||
): TConvertFunc<TOhlcItem, TStochasticResult>;
|
||||
begin
|
||||
var sourceData: TSeries<TOhlcItem>;
|
||||
|
||||
Result :=
|
||||
function(const Value: TOhlcItem): TStochasticResult
|
||||
var
|
||||
i: Integer;
|
||||
highestHigh, lowestLow: Double;
|
||||
begin
|
||||
sourceData.Add(Value, KPeriod);
|
||||
Result.K := Double.NaN;
|
||||
Result.D := Double.NaN;
|
||||
|
||||
if (sourceData.Count >= KPeriod) then
|
||||
begin
|
||||
highestHigh := -MaxDouble;
|
||||
lowestLow := MaxDouble;
|
||||
for i := 0 to KPeriod - 1 do
|
||||
begin
|
||||
// Correctly use High and Low fields
|
||||
if (sourceData[i].High > highestHigh) then
|
||||
highestHigh := sourceData[i].High;
|
||||
if (sourceData[i].Low < lowestLow) then
|
||||
lowestLow := sourceData[i].Low;
|
||||
end;
|
||||
|
||||
if (highestHigh > lowestLow) then
|
||||
// Correctly use the current Close
|
||||
Result.K := 100 * (sourceData[0].Close - lowestLow) / (highestHigh - lowestLow)
|
||||
else
|
||||
Result.K := 100; // Or 50, depends on convention
|
||||
|
||||
Result.D := SmaD(Result.K);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Standard ATR using an EMA for smoothing.
|
||||
class function TIndicators.CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>;
|
||||
begin
|
||||
Result := CreateATR(CreateEMA(Period));
|
||||
end;
|
||||
|
||||
// Calculates the Average True Range (ATR) using an injectable moving average.
|
||||
class function TIndicators.CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>;
|
||||
begin
|
||||
var sourceData: TSeries<TOhlcItem>;
|
||||
|
||||
Result :=
|
||||
function(const Value: TOhlcItem): Double
|
||||
var
|
||||
tr: Double;
|
||||
begin
|
||||
// We only need the previous bar to calculate true range.
|
||||
sourceData.Add(Value, 2);
|
||||
|
||||
if (sourceData.Count < 2) then
|
||||
begin
|
||||
// Feed a dummy value to keep the moving average count in sync. It will correctly return NaN.
|
||||
Result := MovAvgTR(0);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Calculate current True Range.
|
||||
tr := Max(Value.High - Value.Low, Max(Abs(Value.High - sourceData[1].Close), Abs(Value.Low - sourceData[1].Close)));
|
||||
|
||||
// Feed the calculated TR into the provided moving average function.
|
||||
Result := MovAvgTR(tr);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Standard Keltner Channels using an EMA for the middle line and an EMA-based ATR.
|
||||
class function TIndicators.CreateKeltnerChannels(Period: Integer; Multiplier: Double): TConvertFunc<TOhlcItem, TKeltnerChannelsResult>;
|
||||
begin
|
||||
Result := CreateKeltnerChannels(CreateEMA(Period), CreateATR(Period), Multiplier);
|
||||
end;
|
||||
|
||||
// Calculates Keltner Channels using an injectable ATR and middle band moving average.
|
||||
class function TIndicators.CreateKeltnerChannels(
|
||||
const MovAvgMiddle: TConvertFunc<Double, Double>;
|
||||
const AtrFunc: TConvertFunc<TOhlcItem, Double>;
|
||||
Multiplier: Double
|
||||
): TConvertFunc<TOhlcItem, TKeltnerChannelsResult>;
|
||||
begin
|
||||
Result :=
|
||||
function(const Value: TOhlcItem): TKeltnerChannelsResult
|
||||
var
|
||||
atrValue, middleValue, typicalPrice: Double;
|
||||
begin
|
||||
// Calculate Typical Price for the middle band.
|
||||
typicalPrice := (Value.High + Value.Low + Value.Close) / 3.0;
|
||||
|
||||
// Get values from the provided indicator functions.
|
||||
middleValue := MovAvgMiddle(typicalPrice);
|
||||
atrValue := AtrFunc(Value);
|
||||
|
||||
// Set default NaN values for the warm-up period.
|
||||
Result.MiddleBand := middleValue;
|
||||
Result.UpperBand := Double.NaN;
|
||||
Result.LowerBand := Double.NaN;
|
||||
|
||||
// Once both middle band and ATR have valid (non-NaN) values, calculate the channels.
|
||||
if not IsNan(middleValue) and not IsNan(atrValue) then
|
||||
begin
|
||||
Result.UpperBand := middleValue + (atrValue * Multiplier);
|
||||
Result.LowerBand := middleValue - (atrValue * Multiplier);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TIndicators.CreateMean: TConvertFunc<TArray<Double>, Double>;
|
||||
begin
|
||||
Result :=
|
||||
function(const Value: TArray<Double>): Double
|
||||
begin
|
||||
if Length(Value) = 0 then
|
||||
exit(NaN);
|
||||
Result := Value[0];
|
||||
for var i := 1 to High(Value) do
|
||||
Result := Result + Value[i];
|
||||
Result := Result / Length(Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TEMA.CreateEMA(const Param: TParam): TConvertFunc<TInput, TResult>;
|
||||
begin
|
||||
var Period := Param.Period;
|
||||
var lastEma: Double := Double.NaN;
|
||||
var sourceData: TSeries<Double>;
|
||||
var multiplier := 2 / (Period + 1);
|
||||
|
||||
Result :=
|
||||
function(const Value: TInput): TResult
|
||||
begin
|
||||
sourceData.Add(Value.Price, Period);
|
||||
|
||||
if (sourceData.Count < Period) then
|
||||
begin
|
||||
Result.MA := Double.NaN;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not IsNan(lastEma) then
|
||||
begin
|
||||
// Subsequent EMA calculation
|
||||
lastEma := (Value.Price - lastEma) * multiplier + lastEma;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// First EMA is a SMA of the initial period
|
||||
lastEma := TIndicators.CalculateSMA(sourceData, Period);
|
||||
end;
|
||||
Result.MA := lastEma;
|
||||
end;
|
||||
end;
|
||||
finalization
|
||||
Registry.Free;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user