annotate src/clojure/contrib/probabilities/monte_carlo.clj @ 10:ef7dbbd6452c

added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ;; Monte-Carlo algorithms
rlm@10 2
rlm@10 3 ;; by Konrad Hinsen
rlm@10 4 ;; last updated May 3, 2009
rlm@10 5
rlm@10 6 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use
rlm@10 7 ;; and distribution terms for this software are covered by the Eclipse
rlm@10 8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10 9 ;; which can be found in the file epl-v10.html at the root of this
rlm@10 10 ;; distribution. By using this software in any fashion, you are
rlm@10 11 ;; agreeing to be bound by the terms of this license. You must not
rlm@10 12 ;; remove this notice, or any other, from this software.
rlm@10 13
rlm@10 14 (ns
rlm@10 15 ^{:author "Konrad Hinsen"
rlm@10 16 :doc "Monte-Carlo method support
rlm@10 17
rlm@10 18 Monte-Carlo methods transform an input random number stream
rlm@10 19 (usually having a continuous uniform distribution in the
rlm@10 20 interval [0, 1)) into a random number stream whose distribution
rlm@10 21 satisfies certain conditions (usually the expectation value
rlm@10 22 is equal to some desired quantity). They are thus
rlm@10 23 transformations from one probability distribution to another one.
rlm@10 24
rlm@10 25 This library represents a Monte-Carlo method by a function that
rlm@10 26 takes as input the state of a random number stream with
rlm@10 27 uniform distribution (see
rlm@10 28 clojure.contrib.probabilities.random-numbers) and returns a
rlm@10 29 vector containing one sample value of the desired output
rlm@10 30 distribution and the final state of the input random number
rlm@10 31 stream. Such functions are state monad values and can be
rlm@10 32 composed using operations defined in clojure.contrib.monads."}
rlm@10 33 clojure.contrib.probabilities.monte-carlo
rlm@10 34 (:refer-clojure :exclude (deftype))
rlm@10 35 (:use [clojure.contrib.macros :only (const)])
rlm@10 36 (:use [clojure.contrib.types :only (deftype)])
rlm@10 37 (:use [clojure.contrib.stream-utils :only (defstream stream-next)])
rlm@10 38 (:use [clojure.contrib.monads
rlm@10 39 :only (with-monad state-m m-lift m-seq m-fmap)])
rlm@10 40 (:require [clojure.contrib.generic.arithmetic :as ga])
rlm@10 41 (:require [clojure.contrib.accumulators :as acc]))
rlm@10 42
rlm@10 43 ;; Random number transformers and random streams
rlm@10 44 ;;
rlm@10 45 ;; A random number transformer is a function that takes a random stream
rlm@10 46 ;; state as input and returns the next value from the transformed stream
rlm@10 47 ;; plus the new state of the input stream. Random number transformers
rlm@10 48 ;; are thus state monad values.
rlm@10 49 ;;
rlm@10 50 ;; Distributions are implemented as random number transformers that
rlm@10 51 ;; transform a uniform distribution in the interval [0, 1) to the
rlm@10 52 ;; desired distribution. Composition of such distributions allows
rlm@10 53 ;; the realization of any kind of Monte-Carlo algorithm. The result
rlm@10 54 ;; of such a composition is always again a distribution.
rlm@10 55 ;;
rlm@10 56 ;; Random streams are defined by a random number transformer and an
rlm@10 57 ;; input random number stream. If the randon number transformer represents
rlm@10 58 ;; a distribution, the input stream must have a uniform distribution
rlm@10 59 ;; in the interval [0, 1).
rlm@10 60
rlm@10 61 ; Random stream definition
rlm@10 62 (deftype ::random-stream random-stream
rlm@10 63 "Define a random stream by a distribution and the state of a
rlm@10 64 random number stream with uniform distribution in [0, 1)."
rlm@10 65 {:arglists '([distribution random-stream-state])}
rlm@10 66 (fn [d rs] (list d rs)))
rlm@10 67
rlm@10 68 (defstream ::random-stream
rlm@10 69 [[d rs]]
rlm@10 70 (let [[r nrs] (d rs)]
rlm@10 71 [r (random-stream d nrs)]))
rlm@10 72
rlm@10 73 ; Rejection of values is used in the construction of distributions
rlm@10 74 (defn reject
rlm@10 75 "Return the distribution that results from rejecting the values from
rlm@10 76 dist that do not satisfy predicate p."
rlm@10 77 [p dist]
rlm@10 78 (fn [rs]
rlm@10 79 (let [[r nrs] (dist rs)]
rlm@10 80 (if (p r)
rlm@10 81 (recur nrs)
rlm@10 82 [r nrs]))))
rlm@10 83
rlm@10 84 ; Draw a value from a discrete distribution given as a map from
rlm@10 85 ; values to probabilities.
rlm@10 86 ; (see clojure.contrib.probabilities.finite-distributions)
rlm@10 87 (with-monad state-m
rlm@10 88 (defn discrete
rlm@10 89 "A discrete distribution, defined by a map dist mapping values
rlm@10 90 to probabilities. The sum of probabilities must be one."
rlm@10 91 [dist]
rlm@10 92 (letfn [(pick-at-level [l dist-items]
rlm@10 93 (let [[[x p] & rest-dist] dist-items]
rlm@10 94 (if (> p l)
rlm@10 95 x
rlm@10 96 (recur (- l p) rest-dist))))]
rlm@10 97 (m-fmap #(pick-at-level % (seq dist)) stream-next))))
rlm@10 98
rlm@10 99 ; Uniform distribution in an finite half-open interval
rlm@10 100 (with-monad state-m
rlm@10 101 (defn interval
rlm@10 102 [a b]
rlm@10 103 "Transform a sequence of uniform random numbers in the interval [0, 1)
rlm@10 104 into a sequence of uniform random numbers in the interval [a, b)."
rlm@10 105 (let [d (- b a)
rlm@10 106 f (if (zero? a)
rlm@10 107 (if (= d 1)
rlm@10 108 identity
rlm@10 109 (fn [r] (* d r)))
rlm@10 110 (if (= d 1)
rlm@10 111 (fn [r] (+ a r))
rlm@10 112 (fn [r] (+ a (* d r)))))]
rlm@10 113 (m-fmap f stream-next))))
rlm@10 114
rlm@10 115 ; Normal (Gaussian) distribution
rlm@10 116 (defn normal
rlm@10 117 "Transform a sequence urs of uniform random number in the interval [0, 1)
rlm@10 118 into a sequence of normal random numbers with mean mu and standard
rlm@10 119 deviation sigma."
rlm@10 120 [mu sigma]
rlm@10 121 ; This function implements the Kinderman-Monahan ratio method:
rlm@10 122 ; A.J. Kinderman & J.F. Monahan
rlm@10 123 ; Computer Generation of Random Variables Using the Ratio of Uniform Deviates
rlm@10 124 ; ACM Transactions on Mathematical Software 3(3) 257-260, 1977
rlm@10 125 (fn [rs]
rlm@10 126 (let [[u1 rs] (stream-next rs)
rlm@10 127 [u2* rs] (stream-next rs)
rlm@10 128 u2 (- 1. u2*)
rlm@10 129 s (const (* 4 (/ (. Math exp (- 0.5)) (. Math sqrt 2.))))
rlm@10 130 z (* s (/ (- u1 0.5) u2))
rlm@10 131 zz (+ (* 0.25 z z) (. Math log u2))]
rlm@10 132 (if (> zz 0)
rlm@10 133 (recur rs)
rlm@10 134 [(+ mu (* sigma z)) rs]))))
rlm@10 135
rlm@10 136 ; Lognormal distribution
rlm@10 137 (with-monad state-m
rlm@10 138 (defn lognormal
rlm@10 139 "Transform a sequence of uniform random numbesr in the interval [0, 1)
rlm@10 140 into a sequence of lognormal random numbers with mean mu and standard
rlm@10 141 deviation sigma."
rlm@10 142 [mu sigma]
rlm@10 143 (m-fmap #(. Math exp %) (normal mu sigma))))
rlm@10 144
rlm@10 145 ; Exponential distribution
rlm@10 146 (with-monad state-m
rlm@10 147 (defn exponential
rlm@10 148 "Transform a sequence of uniform random numbers in the interval [0, 1)
rlm@10 149 into a sequence of exponential random numbers with parameter lambda."
rlm@10 150 [lambda]
rlm@10 151 (when (<= lambda 0)
rlm@10 152 (throw (IllegalArgumentException.
rlm@10 153 "exponential distribution requires a positive argument")))
rlm@10 154 (let [neg-inv-lambda (- (/ lambda))
rlm@10 155 ; remove very small numbers to prevent log from returning -Infinity
rlm@10 156 not-too-small (reject #(< % 1e-323) stream-next)]
rlm@10 157 (m-fmap #(* (. Math log %) neg-inv-lambda) not-too-small))))
rlm@10 158
rlm@10 159 ; Another implementation of the normal distribution. It uses the
rlm@10 160 ; Box-Muller transform, but discards one of the two result values
rlm@10 161 ; at each cycle because the random number transformer interface cannot
rlm@10 162 ; handle two outputs at the same time.
rlm@10 163 (defn normal-box-muller
rlm@10 164 "Transform a sequence of uniform random numbers in the interval [0, 1)
rlm@10 165 into a sequence of normal random numbers with mean mu and standard
rlm@10 166 deviation sigma."
rlm@10 167 [mu sigma]
rlm@10 168 (fn [rs]
rlm@10 169 (let [[u1 rs] (stream-next rs)
rlm@10 170 [u2 rs] (stream-next rs)
rlm@10 171 v1 (- (* 2.0 u1) 1.0)
rlm@10 172 v2 (- (* 2.0 u2) 1.0)
rlm@10 173 s (+ (* v1 v1) (* v2 v2))
rlm@10 174 ls (. Math sqrt (/ (* -2.0 (. Math log s)) s))
rlm@10 175 x1 (* v1 ls)
rlm@10 176 x2 (* v2 ls)]
rlm@10 177 (if (or (>= s 1) (= s 0))
rlm@10 178 (recur rs)
rlm@10 179 [x1 rs]))))
rlm@10 180
rlm@10 181 ; Finite samples from a distribution
rlm@10 182 (with-monad state-m
rlm@10 183
rlm@10 184 (defn sample
rlm@10 185 "Return the distribution of samples of length n from the
rlm@10 186 distribution dist"
rlm@10 187 [n dist]
rlm@10 188 (m-seq (replicate n dist)))
rlm@10 189
rlm@10 190 (defn sample-reduce
rlm@10 191 "Returns the distribution of the reduction of f over n samples from the
rlm@10 192 distribution dist."
rlm@10 193 ([f n dist]
rlm@10 194 (if (zero? n)
rlm@10 195 (m-result (f))
rlm@10 196 (let [m-f (m-lift 2 f)
rlm@10 197 sample (replicate n dist)]
rlm@10 198 (reduce m-f sample))))
rlm@10 199 ([f val n dist]
rlm@10 200 (let [m-f (m-lift 2 f)
rlm@10 201 m-val (m-result val)
rlm@10 202 sample (replicate n dist)]
rlm@10 203 (reduce m-f m-val sample))))
rlm@10 204
rlm@10 205 (defn sample-sum
rlm@10 206 "Return the distribution of the sum over n samples from the
rlm@10 207 distribution dist."
rlm@10 208 [n dist]
rlm@10 209 (sample-reduce ga/+ n dist))
rlm@10 210
rlm@10 211 (defn sample-mean
rlm@10 212 "Return the distribution of the mean over n samples from the
rlm@10 213 distribution dist"
rlm@10 214 [n dist]
rlm@10 215 (let [div-by-n (m-lift 1 #(ga/* % (/ n)))]
rlm@10 216 (div-by-n (sample-sum n dist))))
rlm@10 217
rlm@10 218 (defn sample-mean-variance
rlm@10 219 "Return the distribution of the mean-and-variance (a vector containing
rlm@10 220 the mean and the variance) over n samples from the distribution dist"
rlm@10 221 [n dist]
rlm@10 222 (let [extract (m-lift 1 (fn [mv] [(:mean mv) (:variance mv)]))]
rlm@10 223 (extract (sample-reduce acc/add acc/empty-mean-variance n dist))))
rlm@10 224
rlm@10 225 )
rlm@10 226
rlm@10 227 ; Uniform distribution inside an n-sphere
rlm@10 228 (with-monad state-m
rlm@10 229 (defn n-sphere
rlm@10 230 "Return a uniform distribution of n-dimensional vectors inside an
rlm@10 231 n-sphere of radius r."
rlm@10 232 [n r]
rlm@10 233 (let [box-dist (sample n (interval (- r) r))
rlm@10 234 sq #(* % %)
rlm@10 235 r-sq (sq r)
rlm@10 236 vec-sq #(apply + (map sq %))
rlm@10 237 sphere-dist (reject #(> (vec-sq %) r-sq) box-dist)
rlm@10 238 as-vectors (m-lift 1 vec)]
rlm@10 239 (as-vectors sphere-dist))))
rlm@10 240