From c58da9412805ccacbdd2c418b47dc0aabe535412 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 13 Jan 2026 11:28:11 +0100 Subject: [PATCH] RTL: Sqrt & Pow --- ASTPlayground/Script.txt | 70 ++++++++++++++++++++++++++++++++++++ Src/AST/Myc.Ast.RTL.Core.pas | 70 ++++++++++++++++++++++++++++++++++++ Src/AST/Myc.Ast.RTL.pas | 22 +++++++++++- 3 files changed, 161 insertions(+), 1 deletion(-) diff --git a/ASTPlayground/Script.txt b/ASTPlayground/Script.txt index 5616609..3e7bf70 100644 --- a/ASTPlayground/Script.txt +++ b/ASTPlayground/Script.txt @@ -1,3 +1,73 @@ (do + ;; --------------------------------------------------------- + ;; 1. Hilfsfunktion: Berechnet den WMA für einen gegebenen + ;; Zeitpunkt auf einer Series. + ;; --------------------------------------------------------- + (def calc-wma + (fn [s len] + (do + (def cnt (count s)) + ;; Wenn nicht genug Daten da sind, gib 0 oder den letzten Wert zurück + (if (< cnt len) + 0.0 + (do + ;; Summe der Gewichte: n * (n + 1) / 2 + (def weight-sum (/ (* len (+ len 1)) 2)) + + ;; Rekursive Berechnung der gewichteten Summe + ;; Wir iterieren von 0 bis len-1 rückwärts + (def w-total + ((fn [i acc] + (if (>= i len) + acc + (do + ;; Gewicht: (len - i) -> Höchstes Gewicht für aktuelles Element + (def w (- len i)) + ;; Wert holen: (get s (count - 1 - i)) + (def val (get s (- (- cnt 1) i))) + ;; Tail-Recursion + (recur (+ i 1) (+ acc (* w val))) + ))) + 0 0.0)) ;; Start bei i=0, acc=0.0 + + ;; Ergebnis: Gewichtete Summe / Summe der Gewichte + (/ w-total weight-sum) + ))))) + ;; --------------------------------------------------------- + ;; 2. Die HMA Factory + ;; --------------------------------------------------------- + (def create-hma + (fn [len] + (do + ;; Konstanten vorberechnen + (def half-len (Round (/ len 2))) + (def sqrt-len (Round (sqrt len))) + + ;; !!! WICHTIG !!! + ;; HMA benötigt eine Glättung der Differenz. + ;; Da 'calc-wma' eine Series als Input erwartet, müssen wir + ;; die Zwischenwerte (diff) in einer eigenen Series speichern. + ;; Diese Series wird in der Closure "gefangen" (captured). + (def diff-series (new-series :Float)) + + ;; Die eigentliche Funktion, die zurückgegeben wird + (fn [source-series] + (do + ;; Schritt 1: WMA(n/2) * 2 + (def wma-half (calc-wma source-series half-len)) + + ;; Schritt 2: WMA(n) + (def wma-full (calc-wma source-series len)) + + ;; Schritt 3: Differenz berechnen + (def diff (- (* 2 wma-half) wma-full)) + + ;; Schritt 4: Differenz in die interne Series schieben + (add-item diff-series diff) + + ;; Schritt 5: WMA(sqrt(n)) auf der Differenz-Series berechnen + (calc-wma diff-series sqrt-len) + )) + ))) ) \ No newline at end of file diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas index 2f2bac5..7ba851c 100644 --- a/Src/AST/Myc.Ast.RTL.Core.pas +++ b/Src/AST/Myc.Ast.RTL.Core.pas @@ -153,6 +153,16 @@ type [AstSignature('(number) -> number')] class function Sign(const Arg: TScalar): TScalar; static; + [TRtlExport('Sqrt', Pure)] + [AstDoc('Returns the square root of a number.')] + [AstSignature('(number) -> number')] + class function Sqrt(const Arg: TScalar): TScalar; static; + + [TRtlExport('Pow', Pure)] + [AstDoc('Returns Base raised to the power of Exponent.')] + [AstSignature('(number, number) -> number')] + class function Pow(const Args: TArray): TDataValue; static; + // --- DateTime --- [TRtlExport('Now', Impure)] @@ -326,6 +336,20 @@ type class function Trunc_Ordinal_Ordinal(A: Int64): Int64; static; [TRtlExport('Trunc', Pure)] class function Trunc_Float_Ordinal(A: Double): Int64; static; + + [TRtlExport('Sqrt', Pure)] + class function Sqrt_Ordinal_Float(A: Int64): Double; static; + [TRtlExport('Sqrt', Pure)] + class function Sqrt_Float_Float(A: Double): Double; static; + + [TRtlExport('Pow', Pure)] + class function Pow_Ordinal_Ordinal_Float(A, B: Int64): Double; static; + [TRtlExport('Pow', Pure)] + class function Pow_Float_Float_Float(A, B: Double): Double; static; + [TRtlExport('Pow', Pure)] + class function Pow_Ordinal_Float_Float(A: Int64; B: Double): Double; static; + [TRtlExport('Pow', Pure)] + class function Pow_Float_Ordinal_Float(A: Double; B: Int64): Double; static; end; implementation @@ -536,6 +560,22 @@ begin end; end; +class function TRtlFunctions.Sqrt(const Arg: TScalar): TScalar; +begin + var val: Double := Arg; // Implicit cast to Double handles both Ordinal and Float + Result := TScalar.FromDouble(System.Sqrt(val)); +end; + +class function TRtlFunctions.Pow(const Args: TArray): TDataValue; +begin + if Length(Args) <> 2 then + raise EArgumentException.Create('Pow requires 2 arguments (Base, Exponent).'); + + var baseVal: Double := Args[0].AsScalar; // Implicit cast + var expVal: Double := Args[1].AsScalar; // Implicit cast + Result := TScalar.FromDouble(System.Math.Power(baseVal, expVal)); +end; + // --- Date Constructors --- class function TRtlFunctions.Now(const Args: TArray): TDataValue; @@ -1024,4 +1064,34 @@ begin Result := System.Trunc(A); end; +class function TRtlFunctions.Sqrt_Ordinal_Float(A: Int64): Double; +begin + Result := System.Sqrt(A); +end; + +class function TRtlFunctions.Sqrt_Float_Float(A: Double): Double; +begin + Result := System.Sqrt(A); +end; + +class function TRtlFunctions.Pow_Ordinal_Ordinal_Float(A, B: Int64): Double; +begin + Result := System.Math.Power(A, B); +end; + +class function TRtlFunctions.Pow_Float_Float_Float(A, B: Double): Double; +begin + Result := System.Math.Power(A, B); +end; + +class function TRtlFunctions.Pow_Ordinal_Float_Float(A: Int64; B: Double): Double; +begin + Result := System.Math.Power(A, B); +end; + +class function TRtlFunctions.Pow_Float_Ordinal_Float(A: Double; B: Int64): Double; +begin + Result := System.Math.Power(A, B); +end; + end. diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas index ec65b8d..62dd9fe 100644 --- a/Src/AST/Myc.Ast.RTL.pas +++ b/Src/AST/Myc.Ast.RTL.pas @@ -78,6 +78,7 @@ type TNativeFunc_O_O = function(A: Int64): Int64; TNativeFunc_F_F = function(A: Double): Double; TNativeFunc_F_O = function(A: Double): Int64; + TNativeFunc_O_F = function(A: Int64): Double; TNativeFunc_OO_O = function(A, B: Int64): Int64; TNativeFunc_OO_F = function(A, B: Int64): Double; @@ -101,6 +102,7 @@ type class function CreateWrapper_O_O(CodeAddress: Pointer): TDataValue.TFunc; static; class function CreateWrapper_F_F(CodeAddress: Pointer): TDataValue.TFunc; static; class function CreateWrapper_F_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_O_F(CodeAddress: Pointer): TDataValue.TFunc; static; class function CreateWrapper_OO_O(CodeAddress: Pointer): TDataValue.TFunc; static; class function CreateWrapper_OO_F(CodeAddress: Pointer): TDataValue.TFunc; static; class function CreateWrapper_FF_F(CodeAddress: Pointer): TDataValue.TFunc; static; @@ -546,6 +548,20 @@ begin end; end; +class function TRtlRegistry.CreateWrapper_O_F(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Int64; + Res: Double; + begin + A := Args[0].AsScalar.Value.AsInt64; + Res := TNativeFunc_O_F(CodeAddress)(A); + Result := TDataValue(TScalar.FromDouble(Res)); + end; +end; + class function TRtlRegistry.CreateWrapper_OO_O(CodeAddress: Pointer): TDataValue.TFunc; begin Result := @@ -703,6 +719,8 @@ begin Result := CreateWrapper_F_F(ptr) else if (argTypes[0].Kind = stFloat) and (retType.Kind = stOrdinal) then Result := CreateWrapper_F_O(ptr) + else if (argTypes[0].Kind = stOrdinal) and (retType.Kind = stFloat) then + Result := CreateWrapper_O_F(ptr) else if (argTypes[0].Kind = stUnknown) and (rttiParams[0].ParamType.Handle = TypeInfo(TScalar)) then begin // This is the wrapper for: class function(Arg: TScalar): TScalar; @@ -767,7 +785,9 @@ begin begin Result := CreateWrapper_TT_T(ptr); // e.g. String concat end - end; + end + else + Assert(false, 'fgdfdf'); end; procedure RegisterRtlFunctions(const AScope: IExecutionScope);