4ad8d2fa97718e13355a4033880aac7154d11af4
[software/python-on-guile.git] / modules / language / python / module / math.scm
1 (define-module (language python module math)
2 #:use-module (language python for)
3 #:use-module (language python try)
4 #:use-module (language python exceptions)
5 #:use-module (language python number)
6 #:use-module (system foreign)
7 #:use-module (rnrs bytevectors)
8
9 #:export (ceil copysign fabs factorial floor fmod frexp fsum gcd isclose
10 isfinite isinf isnan modf trunc exp expm1 log log1p log2 log10
11 pow sqrt acos asin atan cos sin tan atan2 hypot pi
12 degrees radians acosh asinh atanh cosh sinh tanh
13 erf erfc gamma lgamma e tau inf nan))
14
15 (define ceil
16 (lambda (x)
17 ((@ (guile) inexac->exact)
18 ((@ (guile) ceiling)
19 x))))
20
21 (define (copysign x y)
22 (let ((x ((@ (guile) abs) x)))
23 (if (< y 0) (- x) x)))
24
25 (define (fabs x) ((@ (guile) abs) x))
26
27 (define (factorial x)
28 (if (not (and (number? x) (integer? x)))
29 (raise ValueError "Not an integer"))
30 (if (< x 0)
31 (raise ValueError "Negative integer"))
32
33 (let lp ((x x))
34 (if (= x 0)
35 1
36 (* x (lp (- x 1))))))
37
38 (define (floor x)
39 ((@ (guile) inexac->exact)
40 ((@ (guile) floor)
41 x)))
42
43 (define (fmod x y) ((@ (guile) truncate-remainder) x y))
44
45 (define frexp
46 (let ((f (pointer->procedure double
47 (dynamic-func "frexp" (dynamic-link))
48 (list double '*))))
49 (lambda (x)
50 (let* ((v (make-bytevector 4))
51 (vp (bytevector->pointer v)))
52 (list (f x) (bytevector-s32-ref v 0 (native-endianness)))))))
53
54 (define (fsum it)
55 (for ((x : it)) ((s 0))
56 (+ s x)
57 #:final s))
58
59
60 (define gcd (@ (guile) gcd))
61
62 (define* (isclose a b #:key (rel_tol 1e-9) (abs_tol 0.0))
63 (define e-abs (abs (- a b)))
64 (if (< e-abs (max (* rel_tol (max (abs a) (abs b))) abs_tol))
65 #t
66 #f))
67
68 (define (isfinite x)
69 (if (or (inf? x) (nan? x))
70 #f
71 #t))
72
73 (define isinf inf?)
74 (define isnan nan?)
75
76 (define (ldexp x i) (* x ((@ (guile) expt) 2 i)))
77
78 (define (modf x)
79 (let* ((x1 (floor x))
80 (x2 (- x x1)))
81 (values x2 x1)))
82
83 (define trunc py-trunc)
84
85 ;; Power and logarithms
86 (define exp (@ (guile) exp))
87
88 (define expm1
89 (let ((f (pointer->procedure double
90 (dynamic-func "expm1" (dynamic-link))
91 (list double))))
92 (lambda (x) (f x))))
93
94 (define log (@ (guile) log))
95
96 (define log1p
97 (let ((f (pointer->procedure double
98 (dynamic-func "log1p" (dynamic-link))
99 (list double))))
100
101 (lambda (x) (f x))))
102
103 (define log2
104 (let ((f (pointer->procedure double
105 (dynamic-func "log2" (dynamic-link))
106 (list double))))
107 (lambda (x) (f x))))
108
109 (define log10 (@ (guile) log10))
110
111 (define pow expt)
112
113 (define sqrt (@ (guile) sqrt))
114
115 ;; Trigs
116 (define acos (@ (guile) acos))
117 (define asin (@ (guile) asin))
118 (define atan (@ (guile) atan))
119 (define cos (@ (guile) cos))
120 (define sin (@ (guile) sin))
121 (define tan (@ (guile) tan))
122
123 (define atan2
124 (let ((f (pointer->procedure double
125 (dynamic-func "atan2" (dynamic-link))
126 (list double double))))
127 (lambda (x y) (f x y))))
128
129 (define hypot
130 (let ((f (pointer->procedure double
131 (dynamic-func "hypot" (dynamic-link))
132 (list double double))))
133
134 (lambda (x y) (f x y))))
135
136
137 ;; angular conversion
138 (define pi (* 4 (atan 1)))
139
140 (define degrees
141 (let ((f (/ 360 (* 2 pi))))
142 (lambda (x) (* f x))))
143
144 (define radians
145 (let ((f (/ (* 2 pi) 360)))
146 (lambda (x) (* f x))))
147
148 ;; Hyperbolic funcitons
149 (define acosh (@ (guile) acosh))
150 (define asinh (@ (guile) asinh))
151 (define atanh (@ (guile) atanh))
152 (define cosh (@ (guile) cosh))
153 (define sinh (@ (guile) sinh))
154 (define tanh (@ (guile) tanh))
155
156
157 ;; Special functions
158 (define erf
159 (let ((f (pointer->procedure double
160 (dynamic-func "erf" (dynamic-link))
161 (list double))))
162 (lambda (x) (f x))))
163
164 (define erfc
165 (let ((f (pointer->procedure double
166 (dynamic-func "erfc" (dynamic-link))
167 (list double))))
168 (lambda (x) (f x))))
169
170 (define gamma
171 (let ((f (pointer->procedure double
172 (dynamic-func "tgamma" (dynamic-link))
173 (list double))))
174
175 (lambda (x)
176 (if (integer? x)
177 (factorial (- x 1))
178 (f x)))))
179
180 (define lgamma
181 (let ((f (pointer->procedure double
182 (dynamic-func "lgamma" (dynamic-link))
183 (list double))))
184 (lambda (x)
185 (f x))))
186
187 ;; constants
188 (define e (exp 1))
189 (define tau (* 2 pi))
190 (define inf ((@ (guile) inf)))
191 (define nan ((@ (guile) nan)))