RTL: Sqrt & Pow

This commit is contained in:
Michael Schimmel
2026-01-13 11:28:11 +01:00
parent 3c5d51f6a8
commit c58da94128
3 changed files with 161 additions and 1 deletions
+70
View File
@@ -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)
))
)))
)
+70
View File
@@ -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>): 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>): 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>): 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.
+21 -1
View File
@@ -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>): 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);