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.
Fail in CCL but not in SBCL:
(mv-linear-least-squares-example (mv-linear-least-squares-data))
(multimin-example-fletcher-reeves)
series-acceleration
linear-least-squares
nonlinear-least-squares
=== GSL questions ===
Sun Nov 9 2008:
......
;; Definition of GSLL system
;; 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$
(asdf:defsystem "gsll-tests"
......@@ -137,6 +137,7 @@
(:file "roots-one")
(:file "row")
(:file "scale")
(:file "series-acceleration")
(:file "set-basis")
(:file "setf-column")
(:file "setf-row")
......
;; Definition of GSL objects and ways to use them.
;; 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$
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
......@@ -64,12 +64,11 @@
(setf mpointer
(allocate object ,@(symbol-keyword-symbol cl-alloc-args))
(slot-value object 'mpointer) mpointer))
(trivial-garbage:finalize
object
(lambda ()
(cffi:foreign-funcall
,(format nil "~a_free" realprefix)
:pointer mpointer :void))))
(tg:finalize object
(lambda ()
(cffi:foreign-funcall
,(format nil "~a_free" realprefix)
:pointer mpointer :void))))
,@(when initialize-suffix
`((defmfun reinitialize-instance
......
;; Series acceleration.
;; 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$
(in-package :gsl)
......@@ -23,6 +23,9 @@
(dq-den :pointer)
(dsum :pointer))
(defun levin-value (levin slot)
(cffi:foreign-slot-value (mpointer levin) 'levin-c slot))
(defmobject levin "gsl_sum_levin_u"
((order sizet))
"Levin u-transform" ; FDL
......@@ -78,7 +81,7 @@
;;; From Sec. 29.3 in the GSL manual.
(defun acceleration-example ()
(defun acceleration-example (&optional (print-explanation t))
(let ((maxterms 20)
(sum 0.0d0)
(zeta2 (/ (expt pi 2) 6)))
......@@ -89,16 +92,23 @@
(incf sum (maref array n)))
(multiple-value-bind (accelerated-sum error)
(accelerate array levin)
(format t "~&term-by-term sum =~f using ~d terms" sum maxterms)
(format t "~&term-by-term sum =~f using ~d terms"
(cffi:foreign-slot-value levin 'levin-c 'sum-plain)
(cffi:foreign-slot-value levin 'levin-c 'terms-used))
(format t "~&exact value = ~f" zeta2)
(format t "~&accelerated sum = ~f using ~d terms"
(when print-explanation
(format t "term-by-term sum =~f using ~d terms~&" sum maxterms)
(format t "term-by-term sum =~f using ~d terms~&"
(levin-value levin 'sum-plain)
(levin-value levin 'terms-used))
(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
(cffi:foreign-slot-value levin 'levin-c 'terms-used))
(format t "~&estimated error = ~f" error)
(format t "~&actual error = ~f" (- accelerated-sum zeta2))))))
error
(- accelerated-sum zeta2))))))
;; term-by-term sum =1.5961632439130233 using 20 terms
;; term-by-term sum =1.5759958390005426 using 13 terms
......@@ -106,3 +116,5 @@
;; accelerated sum = 1.6449340669228176 using 13 terms
;; estimated error = 0.00000000008883604962761638
;; actual error = 0.00000000007459122208786084
(save-test series-acceleration (acceleration-example nil))
;;; Multivariate roots.
;;; 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$
(in-package :gsl)
......@@ -395,7 +395,6 @@
with fnval and argval
while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7)))
do
(iterate 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