;;; PLT Scheme Science Collection ;;; random-distributions.geometric.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 modules implements geometric distributions. 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 geometric mzscheme (require (lib "contract.ss")) (provide/contract (random-geometric (case-> (-> random-source? (real-in 0.0 1.0) integer?) (-> (real-in 0.0 1.0) integer?))) (geometric-pdf (-> integer? (real-in 0.0 1.0) (>=/c 0.0)))) (require "../random-source.ss") ;; random-geometric: random-source x real -> integer ;; random-geometric: real -> integer ;; ;; This functions returns a random variate from a geometric ;; distribution with probability p. (define random-geometric (case-lambda ((r p) (let ((u (random-uniform r))) (if (= p 1.0) 1 (+ (inexact->exact (truncate (/ (log u) (log (- 1.0 p))))) 1)))) ((p) (random-geometric (current-random-source) p)))) ;; geometric-pdf: integer x real -> real ;; ;; This function computes the probability density p(x) at x for a ;; geometric distribution with probability p. (define (geometric-pdf k p) (cond ((= k 0) 0.0) ((= k 1) p) (else (* p (expt (- 1.0 p) (- k 1.0)))))) )