Raymond Toy
... ... @@ -379,9 +379,10 @@
integrate(t^(a-1)*exp(-t), t, z, inf)"
(with-floating-point-contagion (a z)
(if (zerop a)
;; incomplete_gamma_tail(0, z) = exp_integral_e(1,z)
(exp-integral-e 1 z)
(if (and (realp a) (<= a 0))
;; incomplete_gamma_tail(v, z) = z^v*exp_integral_e(1-a,z)
(* (expt z a)
(exp-integral-e (- 1 a) z))
(if (and (zerop (imagpart a))
(zerop (imagpart z)))
;; For real values, we split the result to compute either the
... ... @@ -531,9 +532,25 @@
;; for |arg(z)| < pi.
;;
;;
(cond ((and (realp v) (minusp v))
;; E(-v, z) = z^(-v-1)*incomplete_gamma_tail(v+1,z)
(let ((-v (- v)))
(let* ((prec (float-contagion v z))
(v (apply-contagion v prec))
(z (apply-contagion z prec)))
(cond ((and (realp v) (minusp v))
;; E(-v, z) = z^(-v-1)*incomplete_gamma_tail(v+1,z)
(let ((-v (- v)))
(* (expt z (- v 1))
(incomplete-gamma-tail (+ -v 1) z))))
((< (abs z) 1)
;; Use series for small z
(s-exp-integral-e v z))
((>= (abs (phase z)) 3.1)
;; The continued fraction doesn't converge on the negative
;; real axis, and converges very slowly near the negative
;; real axis, so use the incomplete-gamma-tail function in
;; this region. "Closeness" to the negative real axis is
;; teken to mean that z is in a sector near the axis.
;;
;; E(v,z) = z^(v-1)*incomplete_gamma_tail(1-v,z)
(* (expt z (- v 1))
(incomplete-gamma-tail (+ -v 1) z))))
((or (< (abs z) 1) (>= (abs (phase z)) 3.1))
... ... @@ -796,18 +813,22 @@
;; So use reflection formula if Re(z) < 0. For z > 0, use the recurrence
;; formula to increase the argument and then apply the asymptotic formula.
(cond ((minusp (realpart z))
(let ((p (float +pi+ (realpart z))))
(cond ((= z 1)
;; psi(1) = -%gamma
(- (float +%gamma+ (if (integerp z) 0.0 z))))
((minusp (realpart z))
(let ((p (float-pi z)))
(flet ((cot-pi (z)
;; cot(%pi*z), car
(handler-case
(/ (tan (* p z)))
(division-by-zero ()
(* 0 z)))))
;; cot(%pi*z), carefully. If z is an odd multiple
;; of 1/2, cot is 0.
(if (and (realp z)
(= 1/2 (abs (- z (ftruncate z)))))
(float 0 z)
(/ (tan (* p z))))))
(- (psi (- 1 z))
(* p (cot-pi z))))))
(t
(let* ((k (* 2 (1+ (floor (* .41 (- (log (epsilon z) 10)))))))
(let* ((k (* 2 (1+ (floor (* .41 (- (log (epsilon (float (realpart z))) 10)))))))
(m 0)
(y (expt (+ z k) 2))
(x 0))
... ...
... ... @@ -1129,6 +1129,13 @@ the same precision as the argument. The argument can be complex."))
(defmethod float-pi ((z qd-complex))
+pi+)
(defmethod float-nan-p ((x cl:float))
;; CMUCL has ext:float-nan-p. Should we use that instead?
(not (= x x)))
(defmethod float-nan-p ((x qd-real))
(float-nan-p (qd-parts (qd-value x))))
(define-condition domain-error (simple-error)
((function-name :accessor condition-function-name
... ... @@ -1139,4 +1146,4 @@ the same precision as the argument. The argument can be complex."))
(pprint-logical-block (stream nil :per-line-prefix " ")
(apply #'format stream
(simple-condition-format-control condition)
(simple-condition-format-arguments condition))))))
\ No newline at end of file
(simple-condition-format-arguments condition))))))
... ...
... ... @@ -212,6 +212,8 @@
#:rational
#:rationalize
)
#+cmu
(:shadow ext:float-nan-p)
;; Export types
(:export #:qd-real
#:qd-complex)
... ...
... ... @@ -45,10 +45,18 @@
t
(- (log err 2)))))
;; Check actual value EST is with LIMIT bits of the true value TRUE.
;; If so, return NIL. Otherwise, return a list of the actual bits of
;; accuracy, the desired accuracy, and the values. This is mostly to
;; make it easy to see what the actual accuracy was and the arguments
;; for the test, which is important for the tests that use random
;; values.
(defun check-accuracy (limit est true)
(let ((bits (bit-accuracy est true)))
(if (numberp bits)
(if (< bits limit)
(if (not (eq bits t))
(if (and (not (float-nan-p (realpart est)))
(not (float-nan-p bits))
(< bits limit))
(list bits limit est true)))))
(defvar *null* (make-broadcast-stream))
... ... @@ -1493,4 +1501,19 @@
(e (exp-integral-e #q2 x))
(true #q0.326643862324553017730401565333637835828494690329010198058745549181386569998611289568))
(check-accuracy 208.4 e true))
nil)
\ No newline at end of file
nil)
(rt:deftest expintegral-e.6d
(let* ((x .5d0)
(e (exp-integral-e 1d0 x))
(true #q0.55977359477616081174679593931508523522684689031635351524829321910733989883))
(check-accuracy 53.9 e true))
nil)
(rt:deftest expintegral-e.6q
(let* ((x #q.5)
(e (exp-integral-e #q1 x))
(true #q0.55977359477616081174679593931508523522684689031635351524829321910733989883))
(check-accuracy 219.1 e true))
nil)
... ...