From deac5976d743a49c24f821da5ded1aadc03a7b47 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Mon, 9 Apr 2018 14:11:31 +0200
Subject: math functions added

---
 modules/language/python/module/math.scm | 191 ++++++++++++++++++++++++++++++++
 1 file changed, 191 insertions(+)
 create mode 100644 modules/language/python/module/math.scm

diff --git a/modules/language/python/module/math.scm b/modules/language/python/module/math.scm
new file mode 100644
index 0000000..4ad8d2f
--- /dev/null
+++ b/modules/language/python/module/math.scm
@@ -0,0 +1,191 @@
+(define-module (language python module math)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python exceptions)
+  #:use-module (language python number)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  
+  #:export (ceil copysign fabs factorial floor fmod frexp fsum gcd isclose
+		 isfinite isinf isnan modf trunc exp expm1 log log1p log2 log10
+		 pow sqrt acos asin atan cos sin tan atan2 hypot pi
+		 degrees radians acosh asinh atanh cosh sinh tanh
+		 erf erfc gamma lgamma e tau inf nan))
+
+(define ceil
+  (lambda (x)
+    ((@ (guile) inexac->exact)
+     ((@ (guile) ceiling)
+      x))))
+  
+(define (copysign x y)
+  (let ((x ((@ (guile) abs) x)))
+    (if (< y 0) (- x) x)))
+
+(define (fabs x) ((@ (guile) abs) x))
+
+(define (factorial x)
+  (if (not (and (number? x) (integer? x)))
+      (raise ValueError "Not an integer"))
+  (if (< x 0)
+      (raise ValueError "Negative integer"))
+
+  (let lp ((x x))
+    (if (= x 0)
+	1
+	(* x (lp (- x 1))))))
+
+(define (floor x)
+  ((@ (guile) inexac->exact)
+   ((@ (guile) floor)
+    x)))
+
+(define (fmod x y) ((@ (guile) truncate-remainder) x y))
+
+(define frexp
+  (let ((f (pointer->procedure double
+                               (dynamic-func "frexp" (dynamic-link))
+                               (list double '*))))
+    (lambda (x)
+      (let* ((v  (make-bytevector 4))
+	     (vp (bytevector->pointer v)))
+	(list (f x) (bytevector-s32-ref v 0 (native-endianness)))))))
+
+(define (fsum it)
+  (for ((x : it)) ((s 0))
+       (+ s x)
+       #:final s))
+       
+
+(define gcd (@ (guile) gcd))
+
+(define* (isclose a b #:key (rel_tol 1e-9) (abs_tol 0.0))
+  (define e-abs (abs (- a b)))
+  (if (< e-abs (max (* rel_tol (max (abs a) (abs b))) abs_tol))
+      #t
+      #f))
+
+(define (isfinite x)
+  (if (or (inf? x) (nan? x))
+      #f
+      #t))
+
+(define isinf inf?)
+(define isnan nan?)
+
+(define (ldexp x i) (* x ((@ (guile) expt) 2 i)))
+
+(define (modf x)
+  (let* ((x1 (floor x))
+	 (x2 (- x x1)))
+    (values x2 x1)))
+
+(define trunc py-trunc)
+
+;; Power and logarithms
+(define exp (@ (guile) exp))
+
+(define expm1
+  (let ((f (pointer->procedure double
+                               (dynamic-func "expm1" (dynamic-link))
+                               (list double))))
+    (lambda (x) (f x))))
+
+(define log (@ (guile) log))
+
+(define log1p
+  (let ((f (pointer->procedure double
+                               (dynamic-func "log1p" (dynamic-link))
+                               (list double))))
+
+    (lambda (x) (f x))))
+
+(define log2
+  (let ((f (pointer->procedure double
+                               (dynamic-func "log2" (dynamic-link))
+                               (list double))))
+    (lambda (x) (f x))))
+
+(define log10 (@ (guile) log10))
+
+(define pow expt)
+
+(define sqrt (@ (guile) sqrt))
+
+;; Trigs
+(define acos (@ (guile) acos))
+(define asin (@ (guile) asin))
+(define atan (@ (guile) atan))
+(define cos  (@ (guile) cos))
+(define sin  (@ (guile) sin))
+(define tan  (@ (guile) tan))
+
+(define atan2
+  (let ((f (pointer->procedure double
+                               (dynamic-func "atan2" (dynamic-link))
+                               (list double double))))
+    (lambda (x y) (f x y))))
+
+(define hypot
+  (let ((f (pointer->procedure double
+                               (dynamic-func "hypot" (dynamic-link))
+                               (list double double))))
+
+    (lambda (x y) (f x y))))
+
+
+;; angular conversion
+(define pi (* 4 (atan 1)))
+
+(define degrees
+  (let ((f (/ 360 (* 2 pi))))
+    (lambda (x) (* f x))))
+
+(define radians
+  (let ((f (/ (* 2 pi) 360)))
+    (lambda (x) (* f x))))
+
+;; Hyperbolic funcitons
+(define acosh (@ (guile) acosh))
+(define asinh (@ (guile) asinh))
+(define atanh (@ (guile) atanh))
+(define cosh  (@ (guile) cosh))
+(define sinh  (@ (guile) sinh))
+(define tanh  (@ (guile) tanh))
+
+
+;; Special functions
+(define erf
+  (let ((f (pointer->procedure double
+                               (dynamic-func "erf" (dynamic-link))
+                               (list double))))
+    (lambda (x) (f x))))
+
+(define erfc
+  (let ((f (pointer->procedure double
+                               (dynamic-func "erfc" (dynamic-link))
+                               (list double))))
+    (lambda (x) (f x))))
+
+(define gamma
+  (let ((f (pointer->procedure double
+                               (dynamic-func "tgamma" (dynamic-link))
+                               (list double))))
+
+    (lambda (x)
+      (if (integer? x)
+	  (factorial (- x 1)) 
+	  (f x)))))
+
+(define lgamma
+  (let ((f (pointer->procedure double
+                               (dynamic-func "lgamma" (dynamic-link))
+                               (list double))))
+    (lambda (x)
+      (f x))))
+
+;; constants
+(define e   (exp 1))
+(define tau (* 2 pi))
+(define inf ((@ (guile) inf)))
+(define nan ((@ (guile) nan)))
-- 
cgit v1.2.3