From 791f629a108ba243ba43fb6c804f2076ed88478f Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sun, 27 Jul 2025 14:05:54 +0200 Subject: [PATCH] Generic indicator factory --- AuraTrader/AuraTrader.dpr | 2 +- AuraTrader/AuraTrader.dproj | 2 +- AuraTrader/MainForm.pas | 7 +- AuraTrader/StrategyTest.pas | 2 +- AuraTrader/TestMethodCallFromRecordParams.pas | 305 +++---- Src/Myc.Data.Records.pas | 30 +- Src/Myc.Trade.Indicators.Common.pas | 489 ++++++++++ Src/Myc.Trade.Indicators.pas | 859 ++++++++---------- 8 files changed, 1047 insertions(+), 649 deletions(-) create mode 100644 Src/Myc.Trade.Indicators.Common.pas diff --git a/AuraTrader/AuraTrader.dpr b/AuraTrader/AuraTrader.dpr index b482af9..7f0aff3 100644 --- a/AuraTrader/AuraTrader.dpr +++ b/AuraTrader/AuraTrader.dpr @@ -8,7 +8,7 @@ uses TestModule in 'TestModule.pas', DynamicFMXControl in 'DynamicFMXControl.pas', Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas', - TestMethodCallFromRecordParams in 'TestMethodCallFromRecordParams.pas'; + Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas'; {$R *.res} diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj index cc7a5be..864c07b 100644 --- a/AuraTrader/AuraTrader.dproj +++ b/AuraTrader/AuraTrader.dproj @@ -138,7 +138,7 @@ - + Base diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas index 3103136..03db26e 100644 --- a/AuraTrader/MainForm.pas +++ b/AuraTrader/MainForm.pas @@ -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(function(const Value: Double): TEMA.TInput begin Result.Price := Value end) .Chain(EMAConv) .Chain(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; diff --git a/AuraTrader/StrategyTest.pas b/AuraTrader/StrategyTest.pas index 14e72d9..9210629 100644 --- a/AuraTrader/StrategyTest.pas +++ b/AuraTrader/StrategyTest.pas @@ -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, Double>; overload; diff --git a/AuraTrader/TestMethodCallFromRecordParams.pas b/AuraTrader/TestMethodCallFromRecordParams.pas index 05a52bf..8eb81ac 100644 --- a/AuraTrader/TestMethodCallFromRecordParams.pas +++ b/AuraTrader/TestMethodCallFromRecordParams.pas @@ -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 = reference to function(const Value: TValue): TResult; - TIndicatorFactoryProc = reference to function(const Params: TParams): TIndicatorProc; - - IndicatorFactoryAttribute = class(TCustomAttribute); - - TGenericIndicatorFactory = class - private - FParameterLayout: TDataRecord.TLayout; - FFactoryProc: TIndicatorFactoryProc; - public - constructor Create( - const AParameterLayout: TDataRecord.TLayout; - const AFactoryProc: TIndicatorFactoryProc - ); - - class function CreateFromTemplate: TGenericIndicatorFactory; - - function CreateIndicator(const Params: TDataRecord): TIndicatorProc; - 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; 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; static; + end; + procedure Test1(const Log: TStrings); +procedure TestSma(const Log: TStrings); implementation +uses + System.Math; + class function TMyWorker.CreateFactory: TIndicatorFactoryProc; 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 -); -begin - inherited Create; - FParameterLayout := AParameterLayout; - FFactoryProc := AFactoryProc; -end; - -class function TGenericIndicatorFactory.CreateFromTemplate: TGenericIndicatorFactory; -var - Ctx: TRttiContext; - rttiType: TRttiType; - templateFactoryMethod: TRttiMethod; - parameterLayout: TDataRecord.TLayout; - factoryProc: TIndicatorFactoryProc; - -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 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 - 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) 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 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; -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; @@ -236,4 +96,113 @@ begin Assert(desc = 'done'); end; +{ TSmaIndicator } + +class function TSmaIndicator.CreateFactory: TIndicatorFactoryProc; +begin + Result := + function(const Params: TParams): TIndicatorProc + var + // State for the indicator closure + period: Integer; + buffer: TArray; + 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; + args: TDataRecord; + res: TDataRecord; + smaValue: Double; +begin + Log.Add(''); + Log.Add('--- Testing SMA ---'); + + fact := TGenericIndicatorFactory.CreateFromTemplate; + + // 1. Setup indicator parameters. + params := TDataRecord.FromRecord; + params.SetValue('Period', 3); + Log.Add(Format('Creating SMA with Period=%d', [params.GetValue('Period')])); + + // 2. Create the indicator instance. + indi := fact.CreateIndicator(params); + + // 3. Create the arguments record (can be reused). + args := TDataRecord.FromRecord; + + // 4. Feed values and check results. + args.SetValue('Value', 10.0); + res := indi(args); + smaValue := res.GetValue('Sma'); + Log.Add(Format('Input: 10.0 -> SMA: %f', [smaValue])); + Assert(SameValue(smaValue, 10.0)); // Avg of [10] is 10 + + args.SetValue('Value', 11.0); + res := indi(args); + smaValue := res.GetValue('Sma'); + Log.Add(Format('Input: 11.0 -> SMA: %f', [smaValue])); + Assert(SameValue(smaValue, 10.5)); // Avg of [10, 11] is 10.5 + + args.SetValue('Value', 12.0); + res := indi(args); + smaValue := res.GetValue('Sma'); + Log.Add(Format('Input: 12.0 -> SMA: %f', [smaValue])); + Assert(SameValue(smaValue, 11.0)); // Avg of [10, 11, 12] is 11 + + args.SetValue('Value', 13.0); + res := indi(args); + smaValue := res.GetValue('Sma'); + Log.Add(Format('Input: 13.0 -> SMA: %f', [smaValue])); + Assert(SameValue(smaValue, 12.0)); // Avg of [11, 12, 13] is 12 + + args.SetValue('Value', 14.0); + res := indi(args); + smaValue := res.GetValue('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. diff --git a/Src/Myc.Data.Records.pas b/Src/Myc.Data.Records.pas index ce601e9..51163f4 100644 --- a/Src/Myc.Data.Records.pas +++ b/Src/Myc.Data.Records.pas @@ -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(const Src: T); @@ -154,12 +159,19 @@ end; class function TDataRecord.FromRecord: TDataRecord; begin - Result.Create(TLayout.FromRecord); + var layout := TLayout.FromRecord; + 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(const Src: T): TDataRecord; begin - Result.Create(TLayout.FromRecord); + Result := FromRecord; Result.CopyFrom(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 diff --git a/Src/Myc.Trade.Indicators.Common.pas b/Src/Myc.Trade.Indicators.Common.pas new file mode 100644 index 0000000..206f141 --- /dev/null +++ b/Src/Myc.Trade.Indicators.Common.pas @@ -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; const Period: Integer): Double; static; + class function CalculateStdDev(const Series: TSeries; const Period: Integer): Double; static; + class function CalculateWMA(const Series: TSeries; const Period: Integer): Double; static; + public + // Simple Moving Average + class function CreateSMA(Period: Integer): TConvertFunc; static; + // Exponential Moving Average + class function CreateEMA(Period: Integer): TConvertFunc; static; + // Hull Moving Average + class function CreateHMA(Period: Integer): TConvertFunc; static; + // Relative Strength Index + class function CreateRSI(Period: Integer): TConvertFunc; static; + // Moving Average Convergence Divergence + class function CreateMACD(FastPeriod, SlowPeriod, SignalPeriod: Integer): TConvertFunc; overload; static; + class function CreateMACD( + const EmaFast, + EmaSlow, + EmaSignal: TConvertFunc + ): TConvertFunc; overload; static; + // Stochastic Oscillator + class function CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc; overload; static; + class function CreateStochastic( + KPeriod: Integer; + const SmaD: TConvertFunc + ): TConvertFunc; overload; static; + // Bollinger Bands + class function CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc; static; + // Average True Range + class function CreateATR(Period: Integer): TConvertFunc; overload; static; + class function CreateATR(const MovAvgTR: TConvertFunc): TConvertFunc; overload; static; + // Keltner Channels + class function CreateKeltnerChannels( + Period: Integer; + Multiplier: Double + ): TConvertFunc; overload; static; + class function CreateKeltnerChannels( + const MovAvgMiddle: TConvertFunc; + const AtrFunc: TConvertFunc; + Multiplier: Double + ): TConvertFunc; overload; static; + + class function CreateMean: TConvertFunc, Double>; static; + end; + +implementation + +{ TIndicators } + +class function TIndicators.CalculateSMA(const Series: TSeries; 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; 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; 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; +begin + var sourceData: TSeries; + 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; +begin + var lastEma: Double := Double.NaN; + var sourceData: TSeries; + 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; +begin + var periodHalf := Period div 2; + var periodSqrt := Round(Sqrt(Period)); + var sourceData: TSeries; + var diffSeries: TSeries; + + 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; +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): TConvertFunc; +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; +begin + var avgGain: Double := Double.NaN; + var avgLoss: Double := Double.NaN; + var sourceData: TSeries; + + 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; +begin + var sourceData: TSeries; + 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; +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 +): TConvertFunc; +begin + var sourceData: TSeries; + + 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; +begin + Result := CreateATR(CreateEMA(Period)); +end; + +// Calculates the Average True Range (ATR) using an injectable moving average. +class function TIndicators.CreateATR(const MovAvgTR: TConvertFunc): TConvertFunc; +begin + var sourceData: TSeries; + + 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; +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; + const AtrFunc: TConvertFunc; + Multiplier: Double +): TConvertFunc; +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, Double>; +begin + Result := + function(const Value: TArray): 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. diff --git a/Src/Myc.Trade.Indicators.pas b/Src/Myc.Trade.Indicators.pas index ef07e11..ab6664d 100644 --- a/Src/Myc.Trade.Indicators.pas +++ b/Src/Myc.Trade.Indicators.pas @@ -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 = reference to function(const Value: TValue): TResult; + TIndicatorFactoryProc = reference to function(const Params: TParams): TIndicatorProc; - // 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; 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; const Period: Integer): Double; static; - class function CalculateStdDev(const Series: TSeries; const Period: Integer): Double; static; - class function CalculateWMA(const Series: TSeries; const Period: Integer): Double; static; + FName: string; + FShortName: string; public - // Simple Moving Average - class function CreateSMA(Period: Integer): TConvertFunc; static; - // Exponential Moving Average - class function CreateEMA(Period: Integer): TConvertFunc; static; - // Hull Moving Average - class function CreateHMA(Period: Integer): TConvertFunc; static; - // Relative Strength Index - class function CreateRSI(Period: Integer): TConvertFunc; static; - // Moving Average Convergence Divergence - class function CreateMACD(FastPeriod, SlowPeriod, SignalPeriod: Integer): TConvertFunc; overload; static; - class function CreateMACD( - const EmaFast, - EmaSlow, - EmaSignal: TConvertFunc - ): TConvertFunc; overload; static; - // Stochastic Oscillator - class function CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc; overload; static; - class function CreateStochastic( - KPeriod: Integer; - const SmaD: TConvertFunc - ): TConvertFunc; overload; static; - // Bollinger Bands - class function CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc; static; - // Average True Range - class function CreateATR(Period: Integer): TConvertFunc; overload; static; - class function CreateATR(const MovAvgTR: TConvertFunc): TConvertFunc; overload; static; - // Keltner Channels - class function CreateKeltnerChannels( - Period: Integer; - Multiplier: Double - ): TConvertFunc; overload; static; - class function CreateKeltnerChannels( - const MovAvgMiddle: TConvertFunc; - const AtrFunc: TConvertFunc; - Multiplier: Double - ): TConvertFunc; overload; static; - - class function CreateMean: TConvertFunc, 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; + + 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; + 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; + const AShortName, AName, AHint: String + ); + + class function CreateFromTemplate: TGenericIndicatorFactory; + + function CreateIndicator(const Params: TDataRecord): TIndicatorProc; + + 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; public - class function CreateEMA(const Param: TParam): TConvertFunc; static; + constructor Create; + destructor Destroy; override; + + // Register indicator from a template class + procedure RegisterTemplate; + + // Register a pre-built indicator factory + procedure RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String); + + // Find a registered factory by its short name + function Find(const ShortName: string): TItem; + + // Provides read-only access to the list of all registered indicator items + property Items: TArray read FItems; end; +var + Registry: TIndicatorRegistry; + implementation -{ TIndicators } +uses + System.SysUtils, + System.TypInfo, + System.Rtti; -class function TIndicators.CalculateSMA(const Series: TSeries; 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; 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; const Period: Integer): Double; -var - i: Integer; - numerator: Double; - denominator: Int64; +{ TGenericIndicatorFactory } + +constructor TGenericIndicatorFactory.Create( + const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout; + const AFactoryProc: TIndicatorFactoryProc; + 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: TGenericIndicatorFactory; +var + Ctx: TRttiContext; + rttiType: TRttiType; + paramsType, argsType, resultType: TRttiType; + templateFactoryMethod: TRttiMethod; + parameterLayout, argumentLayout, resultLayout: TDataRecord.TLayout; + factoryProc: TIndicatorFactoryProc; + shortName, name, hint: string; +begin + // This function creates a generic factory from a template class. + // It uses RTTI to find the necessary types by inspecting the factory method signature, + // and then constructs a set of wrappers to adapt the specific types of the template + // to the generic 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 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; -begin - var sourceData: TSeries; - 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; -begin - var lastEma: Double := Double.NaN; - var sourceData: TSeries; - 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 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; -begin - var periodHalf := Period div 2; - var periodSqrt := Round(Sqrt(Period)); - var sourceData: TSeries; - var diffSeries: TSeries; + // 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) 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 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; +function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): TIndicatorProc; 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): TConvertFunc; +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; +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; + 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; +procedure TIndicatorRegistry.RegisterTemplate; begin - var sourceData: TSeries; - 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; + // 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; -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 -): TConvertFunc; -begin - var sourceData: TSeries; - - 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; -begin - Result := CreateATR(CreateEMA(Period)); -end; - -// Calculates the Average True Range (ATR) using an injectable moving average. -class function TIndicators.CreateATR(const MovAvgTR: TConvertFunc): TConvertFunc; -begin - var sourceData: TSeries; - - 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; -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; - const AtrFunc: TConvertFunc; - Multiplier: Double -): TConvertFunc; -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, Double>; -begin - Result := - function(const Value: TArray): 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; -begin - var Period := Param.Period; - var lastEma: Double := Double.NaN; - var sourceData: TSeries; - 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.