;;; PLT Scheme Science Collection ;;; random-distributions/t-distribution.ss ;;; Copyright (c) 2004 M. Douglas Williams ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public ;;; License as published by the Free Software Foundation; either ;;; version 2.1 of the License, or (at your option) any later version. ;;; ;;; This library 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 ;;; Lesser General Public License for more details. ;;; ;;; You should have received a copy of the GNU Lesser General Public ;;; License along with this library; if not, write to the Free ;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA ;;; 02111-1307 USA. ;;; ;;; ------------------------------------------------------------------- ;;; ;;; This module implements the t-distribution. It is based on the ;;; Random Number Distributions in the GNU Scientific Library. ;;; ;;; Version Date Description ;;; 1.0.0 09/28/04 Marked as ready for Release 1.0. Added ;;; contracts for functions. (Doug Williams) (module t-distribution mzscheme (require (lib "contract.ss")) (provide/contract (random-t-distribution (case-> (-> random-source? real? real?) (-> real? real?))) (t-distribution-pdf (-> real? real? (>=/c 0.0)))) (require "../math.ss") (require "../random-source.ss") (require "../special-functions/gamma.ss") (require "gaussian.ss") (require "chi-squared.ss") (require "exponential.ss") ;; random-t-distribution: random-source x real -> real ;; random-t-distribution: real -> real ;; ;; This function returns a random-variate from the t-distribution ;;; with nu degrees of freedom. (define random-t-distribution (case-lambda ((r nu) (if (<= nu 2) (let ((y1 (random-unit-gaussian r)) (y2 (random-chi-squared r nu))) (/ y1 (sqrt (/ y2 nu)))) (let ((y1 0) (y2 0) (z 0)) (let loop () (set! y1 (random-unit-gaussian r)) (set! y2 (random-exponential r (/ 1 (- (/ nu 2) 1)))) (set! z (/ (* y1 y1) (- nu 2))) (if (or (< (- 1 z) 0) (> (exp (- (- y2) z)) (- 1 z))) (loop))) (* (/ y2 (sqrt (- 1 (/ 2 nu)))) (- 1 z))))) ((nu) (random-t-distribution (current-random-source) nu)))) ;; t-distribution-pdf: real x real -> real ;; ;; This function computes the probability density p(x) at x for a ;; t-distribution with nu degrees of freedom. (define (t-distribution-pdf x nu) (let ((lg1 (lngamma (/ nu 2.0))) (lg2 (lngamma (/ (+ nu 1.0) 2.0)))) (* (/ (exp (- lg2 lg1)) (sqrt (* pi nu))) (expt (+ 1.0 (/ (* x x) nu)) (/ (- (+ nu 1.0)) 2.0))))) )