Commit 6162b30b 6162b30bff1a78bcf7757476e8b05346af85f0e2 by Raymond Toy

Merge branch 'master' of git://common-lisp.net/projects/oct/oct

Conflicts:
	qd-gamma.lisp
2 parents 7eb8fdd7 4b332ed2
......@@ -504,7 +504,8 @@
(loop for k from 0 below n
for term = 1 then (* term (/ -z k))
for sum = (/ (- 1 v)) then (+ sum (/ term (+ k 1 -v)))
finally (return sum))
when (< (abs term) (* (abs sum) eps))
return sum)
(loop for k from n
for term = 1 then (* term (/ -z k))
for sum = 0 then (+ sum (/ term (+ k 1 -v)))
......@@ -706,6 +707,8 @@
(realpart (ci z))
(ci z))))
;; Array of values of the Bernoulli numbers. We only have enough for
;; the evaluation of the psi function.
(defconstant bern-values
(make-array 55
:initial-contents
......@@ -792,8 +795,15 @@
;; formula to increase the argument and then apply the asymptotic formula.
(cond ((minusp (realpart z))
(- (psi (- 1 z))
(* +pi+ (/ (tan (* +pi+ z))))))
(let ((p (float +pi+ (realpart z))))
(flet ((cot-pi (z)
;; cot(%pi*z), car
(handler-case
(/ (tan (* p z)))
(division-by-zero ()
(* 0 z)))))
(- (psi (- 1 z))
(* p (cot-pi z))))))
(t
(let* ((k (* 2 (1+ (floor (* .41 (- (log (epsilon z) 10)))))))
(m 0)
......
......@@ -1363,3 +1363,88 @@
(check-accuracy 212 s true))
nil)
(rt:deftest psi.1d
(let* ((z 1d0)
(p (psi z))
(true (float (- +%gamma+) 1d0)))
(check-accuracy 52 p true))
nil)
(rt:deftest psi.1q
(let* ((z #q1)
(p (psi z))
(true (- +%gamma+)))
(check-accuracy 208 p true))
nil)
(rt:deftest psi.2d
(let* ((z (float 4/3 1d0))
(p (psi z))
(true (- 3
+%gamma+
(/ +pi+ (* 2 (sqrt #q3)))
(* 1.5 (log #q3)))))
(check-accuracy 49.8 p true))
nil)
(rt:deftest psi.2d
(let* ((z (float 4/3 #q1))
(p (psi z))
(true (- 3
+%gamma+
(/ +pi+ (* 2 (sqrt #q3)))
(* 1.5 (log #q3)))))
(check-accuracy 205 p true))
nil)
(rt:deftest psi.3d
(let* ((z (float -1/2 1d0))
(p (psi z))
(true (- 2
+%gamma+
(log #q4))))
(check-accuracy 48 p true))
nil)
(rt:deftest psi.3q
(let* ((z (float -1/2 #q1))
(p (psi z))
(true (- 2
+%gamma+
(log #q4))))
(check-accuracy 204.1 p true))
nil)
(rt:deftest expintegral-e.1d
(let* ((z 1d0)
(e (exp-integral-e 0 z))
(true (/ (exp (- z)) z)))
(check-accuracy 53 e true))
nil)
(rt:deftest expintegral-e.1q
(let* ((z #q1)
(e (exp-integral-e 0 z))
(true (/ (exp (- z)) z)))
(check-accuracy 212 e true))
nil)
(rt:deftest expintegral-e.2d
(let* ((z 15d0)
(e (exp-integral-e 0 z))
(true (/ (exp (- z)) z)))
(check-accuracy 53 e true))
nil)
(rt:deftest expintegral-e.2q
(let* ((z #q15)
(e (exp-integral-e 0 z))
(true (/ (exp (- z)) z)))
(check-accuracy 212 e true))
nil)
(rt:deftest expintegral-e.3d
(let* ((e (exp-integral-e 2 1d0))
(true 0.14849550677592204791835999d0))
(check-accuracy 47.5 e true))
nil)
\ No newline at end of file
......