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

Generic indicator factory

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