Commit 6cfb0ac4 by Raymond Toy

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

parents 8ec0d200 dd5c2a4a
 ... ... @@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!