Commit 0d487e0e authored by Liam Healy's avatar Liam Healy
Browse files

Use GSL tests for random distributions: tdist, laplace

Use GSL tests for random distributions.  Port all tdist tests; some of
laplace.
parent 80387572
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2010-02-07 16:58:10EST gsll.asd>
;; Time-stamp: <2010-04-17 18:47:14EDT gsll.asd>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -160,6 +160,7 @@
((:file "rng-types")
(:file "generators" :depends-on ("rng-types"))
(:file "quasi" :depends-on ("rng-types" "generators"))
(:file "tests")
(:file "gaussian" :depends-on ("rng-types"))
(:file "gaussian-tail" :depends-on ("rng-types"))
(:file "gaussian-bivariate" :depends-on ("rng-types"))
......
;; Mathematical functions
;; Liam Healy, Wed Mar 8 2006 - 22:09
;; Time-stamp: <2009-12-27 09:55:41EST mathematical.lisp>
;; Time-stamp: <2010-04-18 00:22:18EDT mathematical.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -75,7 +75,7 @@
:return ((pmnil cr))
:documentation ; FDL
"Return +1 if x is positive infinity, -1 if negative infinity
nil if finite.")
nil if finite. Some platforms will return only +1 for either sign.")
(defmfun finitep (x)
"gsl_finite" ((x :double))
......
;; Exponential distribution
;; Liam Healy, Sun Sep 17 2006
;; Time-stamp: <2010-01-17 10:25:36EST laplace.lisp>
;; Time-stamp: <2010-04-17 18:49:47EDT laplace.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -73,12 +73,8 @@
;;; Examples and unit test
(save-test laplace
(let ((rng (make-random-number-generator +mt19937+ 0)))
(loop for i from 0 to 10
collect
(sample rng :laplace :a 10.0d0)))
(laplace-pdf 0.0d0 10.0d0)
(laplace-p 1.0d0 2.0d0)
(laplace-q 1.0d0 2.0d0)
(laplace-pinv 0.6967346701436833d0 2.0d0)
(laplace-qinv 0.3032653298563167d0 2.0d0))
(testpdf 'laplace-pdf :laplace :a 2.75d0)
(laplace-p 1.0d0 2.0d0)
(laplace-q 1.0d0 2.0d0)
(laplace-pinv 0.6967346701436833d0 2.0d0)
(laplace-qinv 0.3032653298563167d0 2.0d0))
;; Tdist distribution
;; Liam Healy, Sat Oct 7 2006 - 16:13
;; Time-stamp: <2010-01-17 10:36:02EST tdist.lisp>
;; Time-stamp: <2010-04-18 00:27:57EDT tdist.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -73,12 +73,304 @@
;;; Examples and unit test
(save-test tdist
(let ((rng (make-random-number-generator +mt19937+ 0)))
(loop for i from 0 to 10
collect
(sample rng :tdist :nu 10.0d0)))
(tdist-pdf 0.5d0 1.0d0)
(tdist-P 0.5d0 1.0d0)
(tdist-Q 0.5d0 1.0d0)
(tdist-Pinv 0.6475836176504334d0 1.0d0)
(tdist-Qinv 0.3524163823495667d0 1.0d0))
(testpdf 'tdist-pdf :tdist :nu 1.75d0)
(testpdf 'tdist-pdf :tdist :nu 12.75d0)
;; From test_tdist in cdf/test.c
(tdist-P 0.0d0 1.0d0)
(tdist-P 1d-100 1.0d0)
(tdist-P 0.001d0 1.0d0)
(tdist-P 0.01d0 1.0d0)
(tdist-P 0.1d0 1.0d0)
(tdist-P 0.325d0 1.0d0)
(tdist-P 1.0d0 1.0d0)
(tdist-P 1.5d0 1.0d0)
(tdist-P 2.0d0 1.0d0)
(tdist-P 10.0d0 1.0d0)
(tdist-P 20.0d0 1.0d0)
(tdist-P 100.0d0 1.0d0)
(tdist-P 1000.0d0 1.0d0)
(tdist-P 10000.0d0 1.0d0)
(tdist-Q 0.0d0 1.0d0)
(tdist-Q 1d-100 1.0d0)
(tdist-Q 0.001d0 1.0d0)
(tdist-Q 0.01d0 1.0d0)
(tdist-Q 0.1d0 1.0d0)
(tdist-Q 0.325d0 1.0d0)
(tdist-Q 1.0d0 1.0d0)
(tdist-Q 1.5d0 1.0d0)
(tdist-Q 2.0d0 1.0d0)
(tdist-Q 10.0d0 1.0d0)
(tdist-Q 20.0d0 1.0d0)
(tdist-Q 100.0d0 1.0d0)
(tdist-Q 1000.0d0 1.0d0)
(tdist-Q 10000.0d0 1.0d0)
(tdist-P -1d-100 1.0d0)
(tdist-P -0.001d0 1.0d0)
(tdist-P -0.01d0 1.0d0)
(tdist-P -0.1d0 1.0d0)
(tdist-P -0.325d0 1.0d0)
(tdist-P -1.0d0 1.0d0)
(tdist-P -1.5d0 1.0d0)
(tdist-P -2.0d0 1.0d0)
(tdist-P -10.0d0 1.0d0)
(tdist-P -20.0d0 1.0d0)
(tdist-P -100.0d0 1.0d0)
(tdist-P -1000.0d0 1.0d0)
(tdist-P -10000.0d0 1.0d0)
(tdist-Q -1d-100 1.0d0)
(tdist-Q -0.001d0 1.0d0)
(tdist-Q -0.01d0 1.0d0)
(tdist-Q -0.1d0 1.0d0)
(tdist-Q -0.325d0 1.0d0)
(tdist-Q -1.0d0 1.0d0)
(tdist-Q -1.5d0 1.0d0)
(tdist-Q -2.0d0 1.0d0)
(tdist-Q -10.0d0 1.0d0)
(tdist-Q -20.0d0 1.0d0)
(tdist-Q -100.0d0 1.0d0)
(tdist-Q -1000.0d0 1.0d0)
(tdist-Q -10000.0d0 1.0d0)
(tdist-P 0.0d0 2.0d0)
(tdist-P 1d-100 2.0d0)
(tdist-P 0.001d0 2.0d0)
(tdist-P 0.01d0 2.0d0)
(tdist-P 0.1d0 2.0d0)
(tdist-P 0.325d0 2.0d0)
(tdist-P 1.0d0 2.0d0)
(tdist-P 1.5d0 2.0d0)
(tdist-P 2.0d0 2.0d0)
(tdist-P 10.0d0 2.0d0)
(tdist-P 20.0d0 2.0d0)
(tdist-P 100.0d0 2.0d0)
(tdist-P 1000.0d0 2.0d0)
(tdist-P 10000.0d0 2.0d0)
(tdist-Q 0.0d0 2.0d0)
(tdist-Q 1d-100 2.0d0)
(tdist-Q 0.001d0 2.0d0)
(tdist-Q 0.01d0 2.0d0)
(tdist-Q 0.1d0 2.0d0)
(tdist-Q 0.325d0 2.0d0)
(tdist-Q 1.0d0 2.0d0)
(tdist-Q 1.5d0 2.0d0)
(tdist-Q 2.0d0 2.0d0)
(tdist-Q 10.0d0 2.0d0)
(tdist-Q 20.0d0 2.0d0)
(tdist-Q 100.0d0 2.0d0)
(tdist-Q 1000.0d0 2.0d0)
(tdist-Q 10000.0d0 2.0d0)
(tdist-P -1.0d-100 2.0d0)
(tdist-P -0.001d0 2.0d0)
(tdist-P -0.01d0 2.0d0)
(tdist-P -0.1d0 2.0d0)
(tdist-P -0.325d0 2.0d0)
(tdist-P -1.0d0 2.0d0)
(tdist-P -1.5d0 2.0d0)
(tdist-P -2.0d0 2.0d0)
(tdist-P -10.0d0 2.0d0)
(tdist-P -20.0d0 2.0d0)
(tdist-P -100.0d0 2.0d0)
(tdist-P -1000.0d0 2.0d0)
(tdist-P -10000.0d0 2.0d0)
(tdist-Q -1.0d-100 2.0d0)
(tdist-Q -0.001d0 2.0d0)
(tdist-Q -0.01d0 2.0d0)
(tdist-Q -0.1d0 2.0d0)
(tdist-Q -0.325d0 2.0d0)
(tdist-Q -1.0d0 2.0d0)
(tdist-Q -1.5d0 2.0d0)
(tdist-Q -2.0d0 2.0d0)
(tdist-Q -10.0d0 2.0d0)
(tdist-Q -20.0d0 2.0d0)
(tdist-Q -100.0d0 2.0d0)
(tdist-Q -1000.0d0 2.0d0)
(tdist-Q -10000.0d0 2.0d0)
(tdist-P 0.0d0 300.0d0)
(tdist-P 1d-100 300.0d0)
(tdist-P 0.001d0 300.0d0)
(tdist-P 0.01d0 300.0d0)
(tdist-P 0.1d0 300.0d0)
(tdist-P 0.325d0 300.0d0)
(tdist-P 1.0d0 300.0d0)
(tdist-P 1.5d0 300.0d0)
(tdist-P 2.0d0 300.0d0)
(tdist-P 10.0d0 300.0d0)
(tdist-P 20.0d0 300.0d0)
(tdist-P 100.0d0 300.0d0)
(tdist-P 1000.0d0 300.0d0)
(tdist-P 10000.0d0 300.0d0)
(tdist-Q 0.0d0 300.0d0)
(tdist-Q 1d-100 300.0d0)
(tdist-Q 0.001d0 300.0d0)
(tdist-Q 0.01d0 300.0d0)
(tdist-Q 0.1d0 300.0d0)
(tdist-Q 0.325d0 300.0d0)
(tdist-Q 1.0d0 300.0d0)
(tdist-Q 1.5d0 300.0d0)
(tdist-Q 2.0d0 300.0d0)
(tdist-Q 10.0d0 300.0d0)
(tdist-Q 20.0d0 300.0d0)
(tdist-Q 100.0d0 300.0d0)
(tdist-Q 1000.0d0 300.0d0)
(tdist-Q 10000.0d0 300.0d0)
(tdist-P -1.0d-100 300.0d0)
(tdist-P -0.001d0 300.0d0)
(tdist-P -0.01d0 300.0d0)
(tdist-P -0.1d0 300.0d0)
(tdist-P -0.325d0 300.0d0)
(tdist-P -1.0d0 300.0d0)
(tdist-P -1.5d0 300.0d0)
(tdist-P -2.0d0 300.0d0)
(tdist-P -10.0d0 300.0d0)
(tdist-P -20.0d0 300.0d0)
(tdist-P -100.0d0 300.0d0)
(tdist-P -1000.0d0 300.0d0)
(tdist-P -10000.0d0 300.0d0)
(tdist-Q -1.0d-100 300.0d0)
(tdist-Q -0.001d0 300.0d0)
(tdist-Q -0.01d0 300.0d0)
(tdist-Q -0.1d0 300.0d0)
(tdist-Q -0.325d0 300.0d0)
(tdist-Q -1.0d0 300.0d0)
(tdist-Q -1.5d0 300.0d0)
(tdist-Q -2.0d0 300.0d0)
(tdist-Q -10.0d0 300.0d0)
(tdist-Q -20.0d0 300.0d0)
(tdist-Q -100.0d0 300.0d0)
(tdist-Q -1000.0d0 300.0d0)
(tdist-Q -10000.0d0 300.0d0)
(tdist-Pinv 0.5d0 1.0d0)
(tdist-Pinv 5.00318309780080559d-1 1.0d0)
(tdist-Pinv 5.03182992764908255d-1 1.0d0)
(tdist-Pinv 5.31725517430553569d-1 1.0d0)
(tdist-Pinv 6.00023120032852123d-1 1.0d0)
(tdist-Pinv 0.75000000000000000d0 1.0d0)
(tdist-Pinv 8.12832958189001183d-1 1.0d0)
(tdist-Pinv 8.52416382349566726d-1 1.0d0)
(tdist-Pinv 9.68274482569446430d-1 1.0d0)
(tdist-Pinv 9.84097748743823625d-1 1.0d0)
(tdist-Pinv 9.96817007235091745d-1 1.0d0)
(tdist-Pinv 9.99681690219919441d-1 1.0d0)
(tdist-Pinv 9.99968169011487724d-1 1.0d0)
(tdist-Qinv 0.5d0 1.0d0)
(tdist-Qinv 4.99681690219919441d-1 1.0d0)
(tdist-Qinv 4.96817007235091745d-1 1.0d0)
(tdist-Qinv 4.68274482569446430d-1 1.0d0)
(tdist-Qinv 3.99976879967147876d-1 1.0d0)
(tdist-Qinv 2.5d-1 1.0d0)
(tdist-Qinv 1.87167041810998816d-1 1.0d0)
(tdist-Qinv 1.47583617650433274d-1 1.0d0)
(tdist-Qinv 3.17255174305535695d-2 1.0d0)
(tdist-Qinv 1.59022512561763752d-2 1.0d0)
(tdist-Qinv 3.18299276490825515d-3 1.0d0)
(tdist-Qinv 3.18309780080558939d-4 1.0d0)
(tdist-Qinv 3.18309885122757724d-5 1.0d0)
(tdist-Pinv 4.99681690219919441d-1 1.0d0)
(tdist-Pinv 4.96817007235091744d-1 1.0d0)
(tdist-Pinv 4.68274482569446430d-1 1.0d0)
(tdist-Pinv 3.99976879967147876d-1 1.0d0)
(tdist-Pinv 0.25d0 1.0d0)
(tdist-Pinv 1.87167041810998816d-1 1.0d0)
(tdist-Pinv 1.47583617650433274d-1 1.0d0)
(tdist-Pinv 3.17255174305535695d-2 1.0d0)
(tdist-Pinv 1.59022512561763751d-2 1.0d0)
(tdist-Pinv 3.18299276490825514d-3 1.0d0)
(tdist-Pinv 3.18309780080558938d-4 1.0d0)
(tdist-Pinv 3.18309885122757724d-5 1.0d0)
(tdist-Qinv 5.00318309780080559d-1 1.0d0)
(tdist-Qinv 5.03182992764908255d-1 1.0d0)
(tdist-Qinv 5.31725517430553570d-1 1.0d0)
(tdist-Qinv 6.00023120032852124d-1 1.0d0)
(tdist-Qinv 7.5d-1 1.0d0)
(tdist-Qinv 8.12832958189001184d-1 1.0d0)
(tdist-Qinv 8.52416382349566726d-1 1.0d0)
(tdist-Qinv 9.68274482569446430d-1 1.0d0)
(tdist-Qinv 9.84097748743823625d-1 1.0d0)
(tdist-Qinv 9.96817007235091745d-1 1.0d0)
(tdist-Qinv 9.99681690219919441d-1 1.0d0)
(tdist-Qinv 9.99968169011487724d-1 1.0d0)
(tdist-Pinv 4.99646446697795041d-01 2.0d0)
(tdist-Pinv 4.96464554479100486d-01 2.0d0)
(tdist-Pinv 4.64732719207070087d-01 2.0d0)
(tdist-Pinv 3.88014227253126233d-01 2.0d0)
(tdist-Pinv 2.11324865405187118d-01 2.0d0)
(tdist-Pinv 1.36196562445500540d-01 2.0d0)
(tdist-Pinv 9.17517095361369836d-02 2.0d0)
(tdist-Pinv 4.92622851166284542d-03 2.0d0)
(tdist-Pinv 1.24533194618354849d-03 2.0d0)
(tdist-Pinv 4.99925012497812894d-05 2.0d0)
(tdist-Pinv 4.99999250001249998d-07 2.0d0)
(tdist-Pinv 4.99999992500000125d-09 2.0d0)
(tdist-Qinv 5.00353553302204959d-1 2.0d0)
(tdist-Qinv 5.03535445520899514d-1 2.0d0)
(tdist-Qinv 5.35267280792929913d-1 2.0d0)
(tdist-Qinv 6.11985772746873767d-1 2.0d0)
(tdist-Qinv 7.88675134594812882d-1 2.0d0)
(tdist-Qinv 8.63803437554499460d-1 2.0d0)
(tdist-Qinv 9.08248290463863016d-1 2.0d0)
(tdist-Qinv 9.95073771488337155d-1 2.0d0)
(tdist-Qinv 9.98754668053816452d-1 2.0d0)
(tdist-Qinv 9.99950007498750219d-1 2.0d0)
(tdist-Qinv 9.99999500000749999d-1 2.0d0)
(tdist-Qinv 9.99999995000000075d-1 2.0d0)
(tdist-Pinv 5.00000000000000000d-01 300.0d0)
(tdist-Pinv 5.00398609900942949d-01 300.0d0)
(tdist-Pinv 5.03986033020559088d-01 300.0d0)
(tdist-Pinv 5.39794441177768194d-01 300.0d0)
(tdist-Pinv 6.27296201542523812d-01 300.0d0)
(tdist-Pinv 8.40941797784686861d-01 300.0d0)
(tdist-Pinv 9.32666983425369137d-01 300.0d0)
(tdist-Pinv 9.76799239508425455d-01 300.0d0)
(tdist-Pinv 1.00000000000000000d0 300.0d0)
(tdist-Qinv 5.00000000000000000d-01 300.0d0)
(tdist-Qinv 4.99601390099057051d-1 300.0d0)
(tdist-Qinv 4.96013966979440912d-1 300.0d0)
(tdist-Qinv 4.60205558822231806d-1 300.0d0)
(tdist-Qinv 3.72703798457476188d-1 300.0d0)
(tdist-Qinv 1.59058202215313138d-1 300.0d0)
(tdist-Qinv 6.73330165746308628d-2 300.0d0)
(tdist-Qinv 2.32007604915745452d-2 300.0d0)
(tdist-Qinv 8.279313677d-21 300.0d0)
(tdist-Qinv 1.93159812815803978d-57 300.0d0)
(tdist-Qinv 1.02557519997736154d-232 300.0d0)
(tdist-Qinv 0.00000000000000000d0 300.0d0)
(tdist-Pinv 4.99601390099057051d-01 300.0d0)
(tdist-Pinv 4.96013966979440912d-01 300.0d0)
(tdist-Pinv 4.60205558822231806d-01 300.0d0)
(tdist-Pinv 3.72703798457476188d-01 300.0d0)
(tdist-Pinv 1.59058202215313138d-01 300.0d0)
(tdist-Pinv 6.73330165746308628d-02 300.0d0)
(tdist-Pinv 2.32007604915745452d-02 300.0d0)
(tdist-Pinv 8.279313675556272534d-21 300.0d0)
(tdist-Pinv 1.93159812815803978d-57 300.0d0)
(tdist-Pinv 1.02557519997736154d-232 300.0d0)
(tdist-Pinv 0.0 300.0d0)
(tdist-Qinv 5.00398609900942949d-1 300.0d0)
(tdist-Qinv 5.03986033020559088d-1 300.0d0)
(tdist-Qinv 5.39794441177768194d-1 300.0d0)
(tdist-Qinv 6.27296201542523812d-1 300.0d0)
(tdist-Qinv 8.40941797784686862d-1 300.0d0)
(tdist-Qinv 9.32666983425369137d-1 300.0d0)
(tdist-Qinv 9.76799239508425455d-1 300.0d0)
(tdist-Qinv 1.000000000000000000d0 300.0d0))
;; Emulate the GSL tests for random distributions.
;; Liam Healy 2010-04-17 09:44:49EDT tests.lisp
;; Time-stamp: <2010-04-17 18:44:57EDT tests.lisp>
;;
;; Copyright 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gsl)
;; randist/test.c
(defconstant +gslt-BINS+ 100)
(defconstant +gslt-lower-limit+ -5.0d0) ; a
(defconstant +gslt-upper-limit+ 5.0d0) ; b
(defconstant +gslt-bin-size+ ; dx
(/ (- +gslt-upper-limit+ +gslt-lower-limit+) +gslt-BINS+))
(defconstant +initial-number-of-samples+ 100000) ; N
(defun distribution-bin-integral (pdf)
"Compute the CDF for a bin from the PDF."
(let ((cdf (make-array +gslt-BINS+ :element-type 'double-float)))
(dotimes (i +gslt-BINS+ cdf)
(let* ((xtrial (+ +gslt-lower-limit+ (* i +gslt-bin-size+)))
(x (if (< (abs xtrial) 1.0d-10) 0.0d0 xtrial)))
(setf (aref cdf i)
(integration-qags
pdf x (+ x +gslt-bin-size+) 1.0d-16 1.0d-4 1000))))))
(defun bin-samples (count edge number-of-samples distribution &rest distribution-parameters)
"Update the fixnum vectors count and edge with sample random values from the distribution,
and return the mean."
(let ((rng (make-random-number-generator +default-type+))
(total 0.0d0))
(dotimes (i number-of-samples)
(let ((r (apply 'sample rng distribution distribution-parameters)))
(incf total r)
(when (< +gslt-lower-limit+ r +gslt-upper-limit+)
(multiple-value-bind (bin frac)
(floor (- r +gslt-lower-limit+) +gslt-bin-size+)
(if (zerop frac)
(incf (aref edge bin))
(incf (aref count bin)))))))
;; If the bin above is empty, its lower edge hits belong in the lower bin.
(dotimes (i +gslt-BINS+)
(when (and (< (1+ i) +gslt-BINS+) (zerop (aref count i)))
(incf (aref count i) (aref edge (1+ i)))
(setf (aref edge (1+ i)) 0)))
(/ total number-of-samples)))
(defun limits-check (count number-of-samples cdf retry)
"Returns nil if finite and within limits."
(let ((retval nil))
(dotimes (i +gslt-BINS+ retval)
(setf retval
(if (not (finitep (aref cdf i)))
t
(if (not (zerop (aref cdf i)))
(let ((d (- (aref count i) (* number-of-samples (aref cdf i)))))
(and (> (/ d (sqrt (* number-of-samples (aref cdf i)))) 5)
(> d 2)))
(zerop (aref count i)))))
(if (and retry retval) (return retval))
;; Printout out of warning will need
;; (x (+ +gslt-lower-limit+ (* i +gslt-bin-size+)))
(if retval (warn "observed vs. expected")))))
(defun testpdf (pdf distribution &rest distribution-parameters)
"Test the probability density function in the same way that GSL does.
If everything is functioning correctly, this will return T."
(let ((count (make-array +gslt-BINS+ :element-type 'fixnum :initial-element 0))
(edge (make-array +gslt-BINS+ :element-type 'fixnum :initial-element 0))
(number-of-samples +initial-number-of-samples+)
(cdf (distribution-bin-integral
(lambda (x)
(apply pdf x
;; It is assumed that the arguments to the
;; sample function are the same as to the
;; distribution function except without
;; keywords.
(loop for (nil value) on distribution-parameters by #'cddr
collect value))))))
(dotimes (i 50)
(let ((mean
(apply 'bin-samples
count edge number-of-samples
distribution distribution-parameters)))
(unless (finitep mean) (error "mean ~a is not finite" mean))
(if (limits-check count number-of-samples cdf (< (1+ i) 50))
(if (plusp i) (setf number-of-samples (* 2 number-of-samples)))
(return t))))))
......@@ -19,36 +19,17 @@
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST LAPLACE
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
(LIST 0.005166356198580803d0 -3.942577717493807d0
-8.329510281601332d0 1.1159975704649974d0
-6.2234038148786555d0 -35.04800398421181d0
0.8888158320028845d0 7.161892491969776d0
25.24637780914261d0 7.341651048064451d0
6.54142651602034d0))
(MULTIPLE-VALUE-LIST
(LET ((RNG (MAKE-RANDOM-NUMBER-GENERATOR +MT19937+ 0)))
(LOOP FOR I FROM 0 TO 10 COLLECT
(sample rng :laplace :a 10.0d0)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 0.05d0)
(MULTIPLE-VALUE-LIST
(LAPLACE-PDF 0.0d0
10.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.6967346701436833d0)
(MULTIPLE-VALUE-LIST (LAPLACE-P 1.0d0 2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.3032653298563167d0)
(MULTIPLE-VALUE-LIST (LAPLACE-Q 1.0d0 2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 1.0d0)
(MULTIPLE-VALUE-LIST
(LAPLACE-PINV
0.6967346701436833d0
2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 1.0d0)
(MULTIPLE-VALUE-LIST
(LAPLACE-QINV
0.3032653298563167d0
2.0d0))))
(LISP-UNIT::ASSERT-true (testpdf 'laplace-pdf :laplace :a 2.75d0))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.6967346701436833d0)
(MULTIPLE-VALUE-LIST (LAPLACE-P 1.0d0 2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.3032653298563167d0)
(MULTIPLE-VALUE-LIST (LAPLACE-Q 1.0d0 2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0)
(MULTIPLE-VALUE-LIST (LAPLACE-PINV 0.6967346701436833d0 2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0)
(MULTIPLE-VALUE-LIST (LAPLACE-QINV 0.3032653298563167d0 2.0d0))))
;; Regression test TDIST for GSLL, automatically generated
;; Regression test TDIST for GSLL
;;
;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -18,33 +18,318 @@
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST TDIST
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
(LIST 0.14989366374481017d0 0.6794142879291215d0
-1.615833951108472d0 -1.6008862825783456d0
-1.7010935505767397d0 -0.04370959749808691d0
0.12761159276595174d0 -0.019731218255494867d0
-0.6534666117199732d0 0.2035771324523077d0
1.77650300477611d0))
(MULTIPLE-VALUE-LIST
(LET ((RNG (MAKE-RANDOM-NUMBER-GENERATOR +MT19937+ 0)))
(LOOP FOR I FROM 0 TO 10 COLLECT
(sample rng :tdist :nu 10.0d0)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.2546479089470325d0)
(MULTIPLE-VALUE-LIST (TDIST-PDF 0.5d0 1.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.6475836176504332d0)
(MULTIPLE-VALUE-LIST (TDIST-P 0.5d0 1.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.35241638234956685d0)
(MULTIPLE-VALUE-LIST (TDIST-Q 0.5d0 1.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.500000000000001d0)
(MULTIPLE-VALUE-LIST
(TDIST-PINV 0.6475836176504334d0 1.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.5d0)
(MULTIPLE-VALUE-LIST (TDIST-QINV 0.3524163823495667d0 1.0d0))))
(defmacro test-tol6 (&body body)
`(let ((lisp-unit:*epsilon* (* 2 1048576.0 double-float-epsilon)))
(lisp-unit::assert-numerical-equal
,@body)))
(lisp-unit:define-test tdist
(lisp-unit::assert-true (testpdf 'tdist-pdf :tdist :nu 1.75d0))
(lisp-unit::assert-true (testpdf 'tdist-pdf :tdist :nu 12.75d0))
(test-tol6 0.5d0 (tdist-P 0.0d0 1.0d0))
(test-tol6 0.5d0 (tdist-P 1d-100 1.0d0))
(test-tol6 5.00318309780080559d-1 (tdist-P 0.001d0 1.0d0))
(test-tol6 5.03182992764908255d-1 (tdist-P 0.01d0 1.0d0))
(test-tol6 5.31725517430553569d-1 (tdist-P 0.1d0 1.0d0))
(test-tol6 6.00023120032852123d-1 (tdist-P 0.325d0 1.0d0))
(test-tol6 0.75000000000000000d0 (tdist-P 1.0d0 1.0d0))
(test-tol6 8.12832958189001183d-1 (tdist-P 1.5d0 1.0d0))
(test-tol6 8.52416382349566726d-1 (tdist-P 2.0d0 1.0d0))
(test-tol6 9.68274482569446430d-1 (tdist-P 10.0d0 1.0d0))
(test-tol6 9.84097748743823625d-1 (tdist-P 20.0d0 1.0d0))
(test-tol6 9.96817007235091745d-1 (tdist-P 100.0d0 1.0d0))
(test-tol6 9.99681690219919441d-1 (tdist-P 1000.0d0 1.0d0))
(test-tol6 9.99968169011487724d-1 (tdist-P 10000.0d0 1.0d0))
(test-tol6 0.5d0 (tdist-Q 0.0d0 1.0d0))
(test-tol6 0.5d0 (tdist-Q 1d-100 1.0d0))
(test-tol6 4.99681690219919441d-1 (tdist-Q 0.001d0 1.0d0))
(test-tol6 4.96817007235091745d-1 (tdist-Q 0.01d0 1.0d0))
(test-tol6 4.68274482569446430d-1 (tdist-Q 0.1d0 1.0d0))
(test-tol6 3.99976879967147876d-1 (tdist-Q 0.325d0 1.0d0))
(test-tol6 2.5d-1 (tdist-Q 1.0d0 1.0d0))
(test-tol6 1.87167041810998816d-1 (tdist-Q 1.5d0 1.0d0))
(test-tol6 1.47583617650433274d-1 (tdist-Q 2.0d0 1.0d0))
(test-tol6 3.17255174305535695d-2 (tdist-Q 10.0d0 1.0d0))
(test-tol6 1.59022512561763752d-2 (tdist-Q 20.0d0 1.0d0))
(test-tol6 3.18299276490825515d-3 (tdist-Q 100.0d0 1.0d0))
(test-tol6 3.18309780080558939d-4 (tdist-Q 1000.0d0 1.0d0))
(test-tol6 3.18309885122757724d-5 (tdist-Q 10000.0d0 1.0d0))
(test-tol6 0.5d0 (tdist-P -1.0d-100 1.0d0))