обновление библиотеки

doc/KOSLib.txt

@@ -153,13 +153,13 @@ MODULE Math - математические функции
 	PROCEDURE tanh(x: REAL): REAL
 		гиперболический тангенс x
 
-	PROCEDURE arcsinh(x: REAL): REAL
+	PROCEDURE arsinh(x: REAL): REAL
 		обратный гиперболический синус x
 
-	PROCEDURE arccosh(x: REAL): REAL
+	PROCEDURE arcosh(x: REAL): REAL
 		обратный гиперболический косинус x
 
-	PROCEDURE arctanh(x: REAL): REAL
+	PROCEDURE artanh(x: REAL): REAL
 		обратный гиперболический тангенс x
 
 	PROCEDURE round(x: REAL): REAL
@@ -181,6 +181,9 @@ MODULE Math - математические функции
 		если x < 0 возвращает -1
 		если x = 0 возвращает 0
 
+	PROCEDURE fact(n: INTEGER): REAL
+		факториал n
+
 ------------------------------------------------------------------------------
 MODULE Debug - вывод на доску отладки
 	Интерфейс как модуль Out

doc/WinLib.txt

@@ -152,13 +152,13 @@ MODULE Math - математические функции
         PROCEDURE tanh(x: REAL): REAL
                 гиперболический тангенс x
 
-        PROCEDURE arcsinh(x: REAL): REAL
+        PROCEDURE arsinh(x: REAL): REAL
                 обратный гиперболический синус x
 
-        PROCEDURE arccosh(x: REAL): REAL
+        PROCEDURE arcosh(x: REAL): REAL
                 обратный гиперболический косинус x
 
-        PROCEDURE arctanh(x: REAL): REAL
+        PROCEDURE artanh(x: REAL): REAL
                 обратный гиперболический тангенс x
 
         PROCEDURE round(x: REAL): REAL
@@ -180,6 +180,9 @@ MODULE Math - математические функции
                 если x < 0 возвращает -1
                 если x = 0 возвращает 0
 
+        PROCEDURE fact(n: INTEGER): REAL
+                факториал n
+
 ------------------------------------------------------------------------------
 MODULE File - работа с файловой системой
 

lib/KolibriOS/Math.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2013, 2014, 2018 Anton Krotov
+    Copyright 2013, 2014, 2018, 2019 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -251,58 +251,45 @@ END arctan;
 
 
 PROCEDURE sinh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
-        res := 0.0
-    ELSE
-        res := (exp(x) - exp(-x)) / 2.0
-    END
-    RETURN res
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
 END sinh;
 
 
 PROCEDURE cosh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
-        res := 1.0
-    ELSE
-        res := (exp(x) + exp(-x)) / 2.0
-    END
-    RETURN res
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
 END cosh;
 
 
 PROCEDURE tanh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
-        res := 0.0
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
     ELSE
-        res := sinh(x) / cosh(x)
+        x := exp(2.0 * x);
+        x := (x - 1.0) / (x + 1.0)
     END
-    RETURN res
+
+    RETURN x
 END tanh;
 
 
-PROCEDURE arcsinh* (x: REAL): REAL;
-    RETURN ln(x + sqrt((x * x) + 1.0))
-END arcsinh;
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
 
 
-PROCEDURE arccosh* (x: REAL): REAL;
-    RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
-END arccosh;
+PROCEDURE arcosh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
 
 
-PROCEDURE arctanh* (x: REAL): REAL;
+PROCEDURE artanh* (x: REAL): REAL;
 VAR
     res: REAL;
 
@@ -315,7 +302,7 @@ BEGIN
         res := 0.5 * ln((1.0 + x) / (1.0 - x))
     END
     RETURN res
-END arctanh;
+END artanh;
 
 
 PROCEDURE floor* (x: REAL): REAL;
@@ -374,8 +361,24 @@ BEGIN
     ELSE
         res := 0
     END
+
     RETURN res
 END sgn;
 
 
+PROCEDURE fact* (n: INTEGER): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    res := 1.0;
+    WHILE n > 1 DO
+        res := res * FLT(n);
+        DEC(n)
+    END
+
+    RETURN res
+END fact;
+
+
 END Math.

lib/Linux64/Math.ob07

@@ -25,7 +25,7 @@ VAR
     Exp: ARRAY 710 OF REAL;
 
 
-PROCEDURE sqrt* (x: REAL): REAL;
+PROCEDURE [stdcall64] sqrt* (x: REAL): REAL;
 BEGIN
     ASSERT(x >= 0.0);
     SYSTEM.CODE(
@@ -39,6 +39,9 @@ END sqrt;
 
 
 PROCEDURE exp* (x: REAL): REAL;
+CONST
+    e25 = 1.284025416687741484; (* exp(0.25) *)
+
 VAR
     a, s, res: REAL;
     neg: BOOLEAN;
@@ -53,18 +56,23 @@ BEGIN
     IF x < FLT(LEN(Exp)) THEN
         res := Exp[FLOOR(x)];
         x := x - FLT(FLOOR(x));
+        WHILE x >= 0.25 DO
+            res := res * e25;
+            x := x - 0.25
+        END
     ELSE
         res := SYSTEM.INF();
         x := 0.0
     END;
 
-    n := 1;
+    n := 0;
     a := 1.0;
     s := 1.0;
+
     REPEAT
+        INC(n);
         a := a * x / FLT(n);
-        s := s + a;
-        INC(n)
+        s := s + a
     UNTIL a < eps;
 
     IF neg THEN
@@ -80,27 +88,25 @@ END exp;
 PROCEDURE ln* (x: REAL): REAL;
 VAR
     a, x2, res: REAL;
-    k, n: INTEGER;
+    n: INTEGER;
 
 BEGIN
     ASSERT(x > 0.0);
-    UNPK(x, k);
+    UNPK(x, n);
 
-    x := (x - 1.0) / (x + 1.0);
-    x2 := x * x;
-
-    res := x;
-
-    n := 3;
+    x   := (x - 1.0) / (x + 1.0);
+    x2  := x * x;
+    res := x + FLT(n) * (ln2 * 0.5);
+    n   := 1;
 
     REPEAT
+        INC(n, 2);
         x := x * x2;
         a := x / FLT(n);
-        res := res + a;
-        INC(n, 2)
+        res := res + a
     UNTIL a < eps
 
-    RETURN res * 2.0 + FLT(k) * ln2
+    RETURN res * 2.0
 END ln;
 
 
@@ -127,16 +133,17 @@ VAR
 BEGIN
     x := ABS(x);
     ASSERT(x <= MaxCosArg);
-    x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi);
-    x := x * x;
 
+    x   := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi);
+    x   := x * x;
     res := 0.0;
-    a := 1.0;
-    n := 1;
+    a   := 1.0;
+    n   := -1;
+
     REPEAT
+        INC(n, 2);
         res := res + a;
-        a := -a * x / FLT(n*n + n);
-        INC(n, 2)
+        a := -a * x / FLT(n*n + n)
     UNTIL ABS(a) < eps
 
     RETURN res
@@ -159,13 +166,126 @@ BEGIN
 END tan;
 
 
+PROCEDURE arcsin* (x: REAL): REAL;
+
+
+    PROCEDURE arctan (x: REAL): REAL;
+    VAR
+        z, p, k: REAL;
+
+    BEGIN
+        p := x / (x * x + 1.0);
+        z := p * x;
+        x := 0.0;
+        k := 0.0;
+
+        REPEAT
+            k := k + 2.0;
+            x := x + p;
+            p := p * k * z / (k + 1.0)
+        UNTIL p < eps
+
+        RETURN x
+    END arctan;
+
+
+BEGIN
+    ASSERT(ABS(x) <= 1.0);
+
+    IF ABS(x) >= 0.707 THEN
+        x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x)
+    ELSE
+        x := arctan(x / sqrt(1.0 - x * x))
+    END
+
+    RETURN x
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) <= 1.0)
+    RETURN 0.5 * pi - arcsin(x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arcsin(x / sqrt(1.0 + x * x))
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
+    ELSE
+        x := exp(2.0 * x);
+        x := (x - 1.0) / (x + 1.0)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+BEGIN
+    ASSERT(x >= 1.0)
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) < 1.0)
+    RETURN 0.5 * ln((1.0 + x) / (1.0 - x))
+END artanh;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > 0.0 THEN
+        res := 1
+    ELSIF x < 0.0 THEN
+        res := -1
+    ELSE
+        res := 0
+    END
+
+    RETURN res
+END sgn;
+
+
 PROCEDURE fact* (n: INTEGER): REAL;
 VAR
     res: REAL;
 
 BEGIN
     res := 1.0;
-    WHILE n > 0 DO
+    WHILE n > 1 DO
         res := res * FLT(n);
         DEC(n)
     END

lib/Windows32/Math.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2013, 2014, 2018 Anton Krotov
+    Copyright 2013, 2014, 2018, 2019 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -251,58 +251,45 @@ END arctan;
 
 
 PROCEDURE sinh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
-        res := 0.0
-    ELSE
-        res := (exp(x) - exp(-x)) / 2.0
-    END
-    RETURN res
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
 END sinh;
 
 
 PROCEDURE cosh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
-        res := 1.0
-    ELSE
-        res := (exp(x) + exp(-x)) / 2.0
-    END
-    RETURN res
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
 END cosh;
 
 
 PROCEDURE tanh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
-        res := 0.0
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
     ELSE
-        res := sinh(x) / cosh(x)
+        x := exp(2.0 * x);
+        x := (x - 1.0) / (x + 1.0)
     END
-    RETURN res
+
+    RETURN x
 END tanh;
 
 
-PROCEDURE arcsinh* (x: REAL): REAL;
-    RETURN ln(x + sqrt((x * x) + 1.0))
-END arcsinh;
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
 
 
-PROCEDURE arccosh* (x: REAL): REAL;
-    RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
-END arccosh;
+PROCEDURE arcosh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
 
 
-PROCEDURE arctanh* (x: REAL): REAL;
+PROCEDURE artanh* (x: REAL): REAL;
 VAR
     res: REAL;
 
@@ -315,7 +302,7 @@ BEGIN
         res := 0.5 * ln((1.0 + x) / (1.0 - x))
     END
     RETURN res
-END arctanh;
+END artanh;
 
 
 PROCEDURE floor* (x: REAL): REAL;
@@ -374,8 +361,24 @@ BEGIN
     ELSE
         res := 0
     END
+
     RETURN res
 END sgn;
 
 
+PROCEDURE fact* (n: INTEGER): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    res := 1.0;
+    WHILE n > 1 DO
+        res := res * FLT(n);
+        DEC(n)
+    END
+
+    RETURN res
+END fact;
+
+
 END Math.

lib/Windows64/Math.ob07

@@ -25,7 +25,7 @@ VAR
     Exp: ARRAY 710 OF REAL;
 
 
-PROCEDURE sqrt* (x: REAL): REAL;
+PROCEDURE [stdcall64] sqrt* (x: REAL): REAL;
 BEGIN
     ASSERT(x >= 0.0);
     SYSTEM.CODE(
@@ -39,6 +39,9 @@ END sqrt;
 
 
 PROCEDURE exp* (x: REAL): REAL;
+CONST
+    e25 = 1.284025416687741484; (* exp(0.25) *)
+
 VAR
     a, s, res: REAL;
     neg: BOOLEAN;
@@ -53,18 +56,23 @@ BEGIN
     IF x < FLT(LEN(Exp)) THEN
         res := Exp[FLOOR(x)];
         x := x - FLT(FLOOR(x));
+        WHILE x >= 0.25 DO
+            res := res * e25;
+            x := x - 0.25
+        END
     ELSE
         res := SYSTEM.INF();
         x := 0.0
     END;
 
-    n := 1;
+    n := 0;
     a := 1.0;
     s := 1.0;
+
     REPEAT
+        INC(n);
         a := a * x / FLT(n);
-        s := s + a;
-        INC(n)
+        s := s + a
     UNTIL a < eps;
 
     IF neg THEN
@@ -80,27 +88,25 @@ END exp;
 PROCEDURE ln* (x: REAL): REAL;
 VAR
     a, x2, res: REAL;
-    k, n: INTEGER;
+    n: INTEGER;
 
 BEGIN
     ASSERT(x > 0.0);
-    UNPK(x, k);
+    UNPK(x, n);
 
-    x := (x - 1.0) / (x + 1.0);
-    x2 := x * x;
-
-    res := x;
-
-    n := 3;
+    x   := (x - 1.0) / (x + 1.0);
+    x2  := x * x;
+    res := x + FLT(n) * (ln2 * 0.5);
+    n   := 1;
 
     REPEAT
+        INC(n, 2);
         x := x * x2;
         a := x / FLT(n);
-        res := res + a;
-        INC(n, 2)
+        res := res + a
     UNTIL a < eps
 
-    RETURN res * 2.0 + FLT(k) * ln2
+    RETURN res * 2.0
 END ln;
 
 
@@ -127,16 +133,17 @@ VAR
 BEGIN
     x := ABS(x);
     ASSERT(x <= MaxCosArg);
-    x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi);
-    x := x * x;
 
+    x   := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi);
+    x   := x * x;
     res := 0.0;
-    a := 1.0;
-    n := 1;
+    a   := 1.0;
+    n   := -1;
+
     REPEAT
+        INC(n, 2);
         res := res + a;
-        a := -a * x / FLT(n*n + n);
-        INC(n, 2)
+        a := -a * x / FLT(n*n + n)
     UNTIL ABS(a) < eps
 
     RETURN res
@@ -159,13 +166,126 @@ BEGIN
 END tan;
 
 
+PROCEDURE arcsin* (x: REAL): REAL;
+
+
+    PROCEDURE arctan (x: REAL): REAL;
+    VAR
+        z, p, k: REAL;
+
+    BEGIN
+        p := x / (x * x + 1.0);
+        z := p * x;
+        x := 0.0;
+        k := 0.0;
+
+        REPEAT
+            k := k + 2.0;
+            x := x + p;
+            p := p * k * z / (k + 1.0)
+        UNTIL p < eps
+
+        RETURN x
+    END arctan;
+
+
+BEGIN
+    ASSERT(ABS(x) <= 1.0);
+
+    IF ABS(x) >= 0.707 THEN
+        x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x)
+    ELSE
+        x := arctan(x / sqrt(1.0 - x * x))
+    END
+
+    RETURN x
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) <= 1.0)
+    RETURN 0.5 * pi - arcsin(x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arcsin(x / sqrt(1.0 + x * x))
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
+    ELSE
+        x := exp(2.0 * x);
+        x := (x - 1.0) / (x + 1.0)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+BEGIN
+    ASSERT(x >= 1.0)
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) < 1.0)
+    RETURN 0.5 * ln((1.0 + x) / (1.0 - x))
+END artanh;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > 0.0 THEN
+        res := 1
+    ELSIF x < 0.0 THEN
+        res := -1
+    ELSE
+        res := 0
+    END
+
+    RETURN res
+END sgn;
+
+
 PROCEDURE fact* (n: INTEGER): REAL;
 VAR
     res: REAL;
 
 BEGIN
     res := 1.0;
-    WHILE n > 0 DO
+    WHILE n > 1 DO
         res := res * FLT(n);
         DEC(n)
     END