Commit 1060d1dc authored by Liam Healy's avatar Liam Healy

Add series acceleration test

Add series accleration test, which succeeds in SBCL and fails in CCL.
Minor cleanup.
parent 159d983c
...@@ -31,7 +31,9 @@ from the shell; run inside SLIME gives the correct answer. ...@@ -31,7 +31,9 @@ from the shell; run inside SLIME gives the correct answer.
Fail in CCL but not in SBCL: Fail in CCL but not in SBCL:
(mv-linear-least-squares-example (mv-linear-least-squares-data)) (mv-linear-least-squares-example (mv-linear-least-squares-data))
(multimin-example-fletcher-reeves) (multimin-example-fletcher-reeves)
series-acceleration
linear-least-squares
nonlinear-least-squares
=== GSL questions === === GSL questions ===
Sun Nov 9 2008: Sun Nov 9 2008:
......
;; Definition of GSLL system ;; Definition of GSLL system
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2009-01-19 22:43:17EST gsll-tests.asd> ;; Time-stamp: <2009-01-21 22:58:22EST gsll-tests.asd>
;; $Id$ ;; $Id$
(asdf:defsystem "gsll-tests" (asdf:defsystem "gsll-tests"
...@@ -137,6 +137,7 @@ ...@@ -137,6 +137,7 @@
(:file "roots-one") (:file "roots-one")
(:file "row") (:file "row")
(:file "scale") (:file "scale")
(:file "series-acceleration")
(:file "set-basis") (:file "set-basis")
(:file "setf-column") (:file "setf-column")
(:file "setf-row") (:file "setf-row")
......
;; Definition of GSL objects and ways to use them. ;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21 ;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-01-19 13:50:33EST mobject.lisp> ;; Time-stamp: <2009-01-21 22:38:01EST mobject.lisp>
;; $Id$ ;; $Id$
;;; GSL objects are represented in GSLL as and instance of a 'mobject. ;;; GSL objects are represented in GSLL as and instance of a 'mobject.
...@@ -64,12 +64,11 @@ ...@@ -64,12 +64,11 @@
(setf mpointer (setf mpointer
(allocate object ,@(symbol-keyword-symbol cl-alloc-args)) (allocate object ,@(symbol-keyword-symbol cl-alloc-args))
(slot-value object 'mpointer) mpointer)) (slot-value object 'mpointer) mpointer))
(trivial-garbage:finalize (tg:finalize object
object (lambda ()
(lambda () (cffi:foreign-funcall
(cffi:foreign-funcall ,(format nil "~a_free" realprefix)
,(format nil "~a_free" realprefix) :pointer mpointer :void))))
:pointer mpointer :void))))
,@(when initialize-suffix ,@(when initialize-suffix
`((defmfun reinitialize-instance `((defmfun reinitialize-instance
......
;; Series acceleration. ;; Series acceleration.
;; Liam Healy, Wed Nov 21 2007 - 18:41 ;; Liam Healy, Wed Nov 21 2007 - 18:41
;; Time-stamp: <2008-12-26 18:22:40EST series-acceleration.lisp> ;; Time-stamp: <2009-01-21 22:48:11EST series-acceleration.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -23,6 +23,9 @@ ...@@ -23,6 +23,9 @@
(dq-den :pointer) (dq-den :pointer)
(dsum :pointer)) (dsum :pointer))
(defun levin-value (levin slot)
(cffi:foreign-slot-value (mpointer levin) 'levin-c slot))
(defmobject levin "gsl_sum_levin_u" (defmobject levin "gsl_sum_levin_u"
((order sizet)) ((order sizet))
"Levin u-transform" ; FDL "Levin u-transform" ; FDL
...@@ -78,7 +81,7 @@ ...@@ -78,7 +81,7 @@
;;; From Sec. 29.3 in the GSL manual. ;;; From Sec. 29.3 in the GSL manual.
(defun acceleration-example () (defun acceleration-example (&optional (print-explanation t))
(let ((maxterms 20) (let ((maxterms 20)
(sum 0.0d0) (sum 0.0d0)
(zeta2 (/ (expt pi 2) 6))) (zeta2 (/ (expt pi 2) 6)))
...@@ -89,16 +92,23 @@ ...@@ -89,16 +92,23 @@
(incf sum (maref array n))) (incf sum (maref array n)))
(multiple-value-bind (accelerated-sum error) (multiple-value-bind (accelerated-sum error)
(accelerate array levin) (accelerate array levin)
(format t "~&term-by-term sum =~f using ~d terms" sum maxterms) (when print-explanation
(format t "~&term-by-term sum =~f using ~d terms" (format t "term-by-term sum =~f using ~d terms~&" sum maxterms)
(cffi:foreign-slot-value levin 'levin-c 'sum-plain) (format t "term-by-term sum =~f using ~d terms~&"
(cffi:foreign-slot-value levin 'levin-c 'terms-used)) (levin-value levin 'sum-plain)
(format t "~&exact value = ~f" zeta2) (levin-value levin 'terms-used))
(format t "~&accelerated sum = ~f using ~d terms" (format t "exact value = ~f~&" zeta2)
(format t "accelerated sum = ~f using ~d terms~&"
accelerated-sum
(levin-value levin 'terms-used))
(format t "estimated error = ~f~&" error)
(format t "actual error = ~f ~&" (- accelerated-sum zeta2)))
(values sum maxterms
(levin-value levin 'sum-plain)
(levin-value levin 'terms-used)
accelerated-sum accelerated-sum
(cffi:foreign-slot-value levin 'levin-c 'terms-used)) error
(format t "~&estimated error = ~f" error) (- accelerated-sum zeta2))))))
(format t "~&actual error = ~f" (- accelerated-sum zeta2))))))
;; term-by-term sum =1.5961632439130233 using 20 terms ;; term-by-term sum =1.5961632439130233 using 20 terms
;; term-by-term sum =1.5759958390005426 using 13 terms ;; term-by-term sum =1.5759958390005426 using 13 terms
...@@ -106,3 +116,5 @@ ...@@ -106,3 +116,5 @@
;; accelerated sum = 1.6449340669228176 using 13 terms ;; accelerated sum = 1.6449340669228176 using 13 terms
;; estimated error = 0.00000000008883604962761638 ;; estimated error = 0.00000000008883604962761638
;; actual error = 0.00000000007459122208786084 ;; actual error = 0.00000000007459122208786084
(save-test series-acceleration (acceleration-example nil))
;;; Multivariate roots. ;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08 ;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2009-01-19 16:10:31EST roots-multi.lisp> ;;; Time-stamp: <2009-01-21 22:38:26EST roots-multi.lisp>
;;; $Id$ ;;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -395,7 +395,6 @@ ...@@ -395,7 +395,6 @@
with fnval and argval with fnval and argval
while (and (< iter max-iter) while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7))) (not (multiroot-test-residual solver 1.0d-7)))
do do
(iterate solver) (iterate solver)
(setf fnval (cl-array (function-value solver)) (setf fnval (cl-array (function-value solver))
......
;; Regression test SERIES-ACCELERATION for GSLL, automatically generated
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST SERIES-ACCELERATION
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.5961632439130233d0 20 1.5759958390005426d0 13
1.6449340669228176d0 8.883604962761638d-11
7.459122208786084d-11)
(MULTIPLE-VALUE-LIST (ACCELERATION-EXAMPLE NIL))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment