[oct-cvs] Oct commit: oct qd-test.lisp rt-tests.lisp
rtoy
rtoy at common-lisp.net
Tue Sep 18 03:05:56 UTC 2007
Update of /project/oct/cvsroot/oct
In directory clnet:/tmp/cvs-serv24380
Modified Files:
qd-test.lisp rt-tests.lisp
Log Message:
qd-test.lisp:
o Add optional arg to enable/disable printing of results. Default is
on.
rt-tests.lisp:
o Don't print results.
--- /project/oct/cvsroot/oct/qd-test.lisp 2007/08/27 17:49:19 1.18
+++ /project/oct/cvsroot/oct/qd-test.lisp 2007/09/18 03:05:56 1.19
@@ -67,7 +67,7 @@
;; pi =
;; 3.1415926535897932384626433832795028841971693993751058209749445923078L0
-(defun test2 ()
+(defun test2 (&optional (printp t))
;; pi/4 = 4 * arctan(1/5) - arctan(1/239)
;;
;; Arctan is computed using the Taylor series
@@ -100,11 +100,12 @@
(p (mul-qd-d (sub-qd (mul-qd-d s1 4d0)
s2)
4d0)))
- (format t "~2&pi via Machin's atan formula~%")
- (print-result p +qd-pi+)
+ (when printp
+ (format t "~2&pi via Machin's atan formula~%")
+ (print-result p +qd-pi+))
p)))
-(defun test3 ()
+(defun test3 (&optional (printp t))
(declare (optimize (speed 3)))
;; Salamin-Brent Quadratic formula for pi
(let* ((a +qd-one+)
@@ -127,11 +128,12 @@
(setf s s-new)
(setf p (div-qd (mul-qd-d (sqr-qd a) 2d0)
s))))
- (format t "~2&Salamin-Brent Quadratic formula for pi~%")
- (print-result p +qd-pi+)
+ (when printp
+ (format t "~2&Salamin-Brent Quadratic formula for pi~%")
+ (print-result p +qd-pi+))
p))
-(defun test4 ()
+(defun test4 (&optional (printp t))
(declare (optimize (speed 3)))
;; Borwein Quartic formula for pi
(let* ((a (sub-qd (make-qd-d 6d0)
@@ -160,13 +162,14 @@
m)))
(setf p (div-qd +qd-one+
a))))
- (format t "~2&Borwein's Quartic formula for pi~%")
- (print-result p +qd-pi+)
+ (when printp
+ (format t "~2&Borwein's Quartic formula for pi~%")
+ (print-result p +qd-pi+))
p))
;; e =
;; 2.718281828459045235360287471352662497757247093699959574966967627724L0
-(defun test5 ()
+(defun test5 (&optional (printp t))
;; Taylor series for e
(let ((s (make-qd-d 2d0))
(tmp +qd-one+)
@@ -179,13 +182,14 @@
(setf tmp (div-qd tmp
(make-qd-d (float n 1d0))))
(setf s (add-qd s tmp)))
- (format t "~2&e via Taylor series~%")
- (print-result s +qd-e+)
+ (when printp
+ (format t "~2&e via Taylor series~%")
+ (print-result s +qd-e+))
s))
;; log(2) =
;; 0.6931471805599453094172321214581765680755001343602552541206800094934L0
-(defun test6 ()
+(defun test6 (&optional (printp t))
;; Taylor series for log 2
;;
;; -log(1-x) = x + x^2/2 + x^3/3 + x^4/4 + ...
@@ -201,11 +205,12 @@
(setf tt (mul-qd-d tt .5d0))
(setf s (add-qd s
(div-qd tt (make-qd-d (float n 1d0))))))
- (format t "~2&log(2) via Taylor series~%")
- (print-result s +qd-log2+)
+ (when printp
+ (format t "~2&log(2) via Taylor series~%")
+ (print-result s +qd-log2+))
s))
-(defun test-atan (&optional (fun #'atan-qd))
+(defun test-atan (&optional (fun #'atan-qd) (printp t))
;; Compute atan for known values
(format t "~2&atan via ~S~%" fun)
@@ -234,7 +239,7 @@
(format t "bits = ~,1f~%"
(bit-accuracy y true))))
-(defun test-sin ()
+(defun test-sin (&optional (printp t))
(format t "~2&sin~%")
(let* ((arg (div-qd +qd-pi+ (make-qd-d 6d0)))
(y (sin-qd arg))
@@ -259,7 +264,7 @@
(bit-accuracy y true)))
)
-(defun test-tan (&optional (f #'tan-qd))
+(defun test-tan (&optional (f #'tan-qd) (printp t))
(format t "~2&tan via ~S~%" f)
(let* ((arg (div-qd +qd-pi+ (make-qd-d 6d0)))
(y (funcall f arg))
@@ -284,7 +289,7 @@
(bit-accuracy y true)))
)
-(defun test-asin ()
+(defun test-asin (&optional (printp t))
(format t "~2&asin~%")
(let* ((arg (make-qd-d 0.5d0))
(y (asin-qd arg))
@@ -309,7 +314,7 @@
(bit-accuracy y true)))
)
-(defun test-log (f)
+(defun test-log (f &optional (printp t))
(format t "~2&Log via ~A~%" f)
(let* ((arg (make-qd-d 2d0))
(y (funcall f arg))
@@ -334,7 +339,7 @@
(bit-accuracy y true)))
)
-(defun test-log1p (f)
+(defun test-log1p (f &optional (printp t))
(format t "~2&Log1p via ~A~%" f)
(let* ((arg (make-qd-d 1d0))
(y (funcall f arg))
@@ -359,7 +364,7 @@
(bit-accuracy y true)))
)
-(defun test-exp (f)
+(defun test-exp (f &optional (printp t))
(format t "~2&Exp via ~A~%" f)
(let* ((arg +qd-zero+)
(y (funcall f arg))
@@ -385,6 +390,7 @@
(bit-accuracy y true)))
)
+
(defun all-tests ()
(test2)
(test3)
--- /project/oct/cvsroot/oct/rt-tests.lisp 2007/08/27 18:05:12 1.1
+++ /project/oct/cvsroot/oct/rt-tests.lisp 2007/09/18 03:05:56 1.2
@@ -50,7 +50,7 @@
;; Pi via Machin's formula
(rt:deftest oct.pi.machin
(let* ((*standard-output* *null*)
- (val (make-instance 'qd-real :value (qdi::test2)))
+ (val (make-instance 'qd-real :value (qdi::test2 nil)))
(true qd:+pi+))
(check-accuracy 213 val true))
nil)
@@ -58,7 +58,7 @@
;; Pi via Salamin-Brent algorithm
(rt:deftest oct.pi.salamin-brent
(let* ((*standard-output* *null*)
- (val (make-instance 'qd-real :value (qdi::test3)))
+ (val (make-instance 'qd-real :value (qdi::test3 nil)))
(true qd:+pi+))
(check-accuracy 202 val true))
nil)
@@ -66,7 +66,7 @@
;; Pi via Borweign's Quartic formula
(rt:deftest oct.pi.borweign
(let* ((*standard-output* *null*)
- (val (make-instance 'qd-real :value (qdi::test4)))
+ (val (make-instance 'qd-real :value (qdi::test4 nil)))
(true qd:+pi+))
(check-accuracy 211 val true))
nil)
@@ -74,7 +74,7 @@
;; e via Taylor series
(rt:deftest oct.e.taylor
(let* ((*standard-output* *null*)
- (val (make-instance 'qd-real :value (qdi::test5)))
+ (val (make-instance 'qd-real :value (qdi::test5 nil)))
(true (make-instance 'qd-real :value qdi::+qd-e+)))
(check-accuracy 212 val true))
nil)
@@ -82,7 +82,7 @@
;; log(2) via Taylor series
(rt:deftest oct.log2.taylor
(let* ((*standard-output* *null*)
- (val (make-instance 'qd-real :value (qdi::test6)))
+ (val (make-instance 'qd-real :value (qdi::test6 nil)))
(true (make-instance 'qd-real :value qdi::+qd-log2+)))
(check-accuracy 212 val true))
nil)
More information about the oct-cvs
mailing list