On this page:
6.1 Models:   Lightweight Modules
defmodel
defmodel+
open-model
6.2 Lazy Structures
lazy-struct
6.3 Statistical Utilities
statistics
real-vector-like?
samples->statistics
sampler->statistics
samples->mean+  variance
sampler->mean+  variance
samples->mean
sampler->mean
6.4 Utilities for Testing and Comparing Distributions
samples->KS
discrete-dist-error
6.5 Arrays and Matrices
array?
mutable-array?
matrix?
square-matrix?
row-matrix?
col-matrix?
Imm  Array
Mut  Array
Array-contents
array
mutable-array
matrix
col-matrix
row-matrix
for/  matrix
for*/  matrix
matrix11->value
array->immutable-array
make-mutable-matrix
matrix-set!
matrix-symmetric?
array-sqrt/  nan
array-sqrt/  err
matrix-cholesky
matrix-ldl
6.6 Miscellaneous Utilities
probability?
verbose?
repeat
indicator
indicator/  value
indicator/  predicate
resample

6 Utilities

6.1 Models: Lightweight Modules

syntax

(defmodel model-name body ...+)

Defines model-name as a model—a lightweight module. The body forms are not evaluated until the model is invoked using open-model. A model has no “result value”; it only exports the names it defines. Note that model-name can only be used with open-model; in particular, it is not a variable, and a model is not a value.

Every name defined within the model is exported, but an export bound to unknown syntax (eg, a macro definition) raises an error if used. Names bound with defmem and deflazy may be exported and used safely. Names imported via open-model are automatically re-exported.

Examples:

> (defmodel m1
    (define x 1)
    (deflazy y (begin (displayln "computing y!") 2))
    (define-syntax-rule (z) (+ x y)))
> (defmodel m2
    (open-model m1)
    (deflazy w (list x y)))
> (open-model m2)
> w

computing y!

'(1 2)

> x

1

> y

2

> (z) ; can't use macro from model

eval:9:0: z: use of this model export name is not allowed;

 it is bound as syntax in original model

  in: z

Models can be used to define reusable generative models:

> (defmodel true-strength
    ; type Person = Symbol
    ; type Match = (list Team Team)
  
    ; strength : Person -> Real
    (defmem (strength p) (normal 10 2))
  
    ; lazy? : Person -> Boolean
    (define (lazy? p) (flip 0.1))
  
    ; pulling-power : Person -> Real
    (define (pulling-power p)
      (if (lazy? p)
          (/ (strength p) 2.0)
          (strength p)))
  
    ; team-pulling-power : (Listof Person) -> Real
    (define (team-pulling-power t)
      (for/sum ([p (in-list t)]) (pulling-power p)))
  
    ; team1-wins? : Match -> Boolean
    (define (team1-wins? m)
      (> (team-pulling-power (car m))
         (team-pulling-power (cadr m))))
  
    (observe/fail (team1-wins? '((james david) (brian john))) #t))

The generative model can then be combined with different queries:

> (sampler->discrete-dist
    (mh-sampler
      (open-model true-strength)
      (> (strength 'james) (strength 'brian)))
    1000)

(discrete-dist [#f 0.219] [#t 0.781])

> (sampler->discrete-dist
    (mh-sampler
      (open-model true-strength)
      (team1-wins? '((james david) (bob andrew))))
    1000)

(discrete-dist [#f 0.385] [#t 0.615])

syntax

(defmodel+ model-name body ...)

Extends an existing model named model-name with additional body elements, or defines it if it is not already defined.

Examples:

> (defmodel+ arith
    (define a 1)
    (define b 2))
> (defmodel+ arith
    (define c (+ a b)))
> (open-model arith)
> (list a b c)

'(1 2 3)

syntax

(open-model model-name)

Executes the body of the model corresponding to model-name and defines its exported names in the enclosing scope.

6.2 Lazy Structures

syntax

(lazy-struct name-id (field-id ...))

Defines a struct type called name-id whose constructor delays its arguments using pdelay and whose accessors automatically force the corresponding fields. If the constructor name is used with the wrong number of arguments, a compile-time error is raised.

In addition to the standard names (name, name?, name-field ...), the name strict-make-name is bound to a strict constructor procedure.

Printing, equal? comparison, and hashing all automatically force all fields.

Instances of lazy structs can be destructured with match using one of the following patterns:

(name-id #:strict field-pattern ...)

Forces each field and matches it against field-pattern.

(name-id #:thunk field-var-id ...)

Binds each field-var-id to a thunk that when applied forces the corresponding field.

Examples:

> (lazy-struct lpair (x y))
> (define lp (lpair 'a (/ 1 0)))
> (lpair-x lp)

'a

> (lpair-y lp)

/: division by zero

> lp

(lpair 'a (error))

> (match lp
    [(lpair #:thunk get-x get-y)
     (get-x)])

'a

> (match (lpair 'a 'b)
    [(lpair #:strict x y)
     (list x y)])

'(a b)

6.3 Statistical Utilities

struct

(struct statistics (dim n mean cov))

  dim : exact-positive-integer?
  n : exact-positive-integer?
  mean : col-matrix?
  cov : matrix?
Represents some basic statistics of a sample sequence of real vectors of compatible shapes. The dim field represents the dimension of the sample vectors; n is the number of samples; mean is the mean of the samples; and cov is the covariance matrix.

procedure

(real-vector-like? v)  boolean?

  v : any/c
Returns #t if v is a real, a real vector, or a column matrix of reals; #f otherwise.

procedure

(samples->statistics samples)  statistics?

  samples : (vectorof real-vector-like?)

procedure

(sampler->statistics s    
  n    
  [f    
  #:burn burn    
  #:thin thin])  statistics?
  s : sampler?
  n : exact-positive-integer?
  f : (-> any/c real-vector-like?) = values
  burn : exact-nonnegative-integer? = 0
  thin : exact-nonnegative-integer? = 0
Returns the statistics of samples.

The second form is equivalent to the following:

(samples->statistics (generate-samples s n f #:burn burn #:thin thin))

Example:

> (sampler->statistics (mh-sampler (normal 0 1)) 1000)

(statistics

 1

 1000

 (ImmArray (array #[#[-0.0805364081364715]]))

 (ImmArray (array #[#[1.1339004212047163]])))

procedure

(samples->mean+variance rvs)  
real? real?
  rvs : (vectorof real?)

procedure

(sampler->mean+variance sampler    
  n    
  [f    
  #:burn burn    
  #:thin thin])  
real? real?
  sampler : sampler?
  n : exact-positive-integer?
  f : (-> any/c real?) = values
  burn : exact-nonnegative-integer? = 0
  thin : exact-nonnegative-integer? = 0
Like sample->statistics, but returns the mean and variance as two scalar values.

The second form is equivalent to the following:

(samples->mean+variance (generate-samples s n f #:burn burn #:thin thin))

Example:

> (sampler->mean+variance (rejection-sampler (flip 1/2)) 100 (indicator #t))

41/100

2419/9900

procedure

(samples->mean rvs)  any/c

  rvs : (vectorof any/c)

procedure

(sampler->mean sampler    
  n    
  [f    
  #:burn burn    
  #:thin thin])  any/c
  sampler : weighted-sampler?
  n : exact-positive-integer?
  f : (-> any/c any/c) = values
  burn : exact-nonnegative-integer? = 0
  thin : exact-nonnegative-integer? = 0
Like sample->mean+variance, but returns only the mean. In contrast to the other functions in this section, sampler->mean handles weighted samplers, and the sample results can be numbers, lists, vectors, arrays, and matrices. If two values have incompatible shapes, the function returns +nan.0 at the incompatible positions.

Examples:

> (sampler->mean (rejection-sampler (dirichlet '#(1 1 1))) 10)

'#(0.30932591043997065 0.4591082769990751 0.2315658125609543)

> (sampler->mean (rejection-sampler (for/list ([i (+ 2 (discrete-uniform 4))]) 17)) 10)

'(17 17 . +nan.0)

6.4 Utilities for Testing and Comparing Distributions

procedure

(samples->KS samples dist)  real?

  samples : (vectorof real?)
  dist : dist?
Calculates the Kolmogorov–Smirnov statistic of a sample set samples with respect to dist. The result is a measure of the goodness of fit of the samples to the distribution.

Examples:

> (samples->KS (generate-samples (rejection-sampler (uniform 0 1)) 1000)
               (uniform-dist 0 1))

0.01728589978522327

> (samples->KS (generate-samples (rejection-sampler (normal 0 1)) 1000)
               (uniform-dist 0 1))

0.5012497732640326

> (samples->KS (generate-samples (rejection-sampler (for/sum ([i 3]) (uniform -1 1))) 100)
               (normal-dist 0 1))

0.06690828154007988

procedure

(discrete-dist-error dist1 dist2)  (>=/c 0)

  dist1 : discrete-dist?
  dist2 : discrete-dist?
Returns a measure of the difference between two discrete distributions. The result is the probability mass that would need to be reassigned in order to transform dist1 into dist2.

Example:

> (discrete-dist-error
   (discrete-dist ['A 3/5] ['B 2/5])
   (discrete-dist ['A 1/2] ['B 1/2]))

1/10

In the example above, 1/10 of the probability mass of 'A in the first distribution would have to be shifted to 'B to transform the first distribution into the second.

6.5 Arrays and Matrices

This language provides a wrapped version of the array and matrix types defined in math/array and math/matrix. Unlike the version provided by those libraries, this library’s array and matrix types are specialized to real numbers, and they are simpler and faster to use in untyped code.

Most of the functions listed in the documentation for math/array and math/matrix have corresponding monomorphic-wrapped functions exported by this language. In addition, the following functions and special forms are provided.

procedure

(array? v)  boolean?

  v : any/c

procedure

(mutable-array? v)  boolean?

  v : any/c

procedure

(matrix? v)  boolean?

  v : any/c

procedure

(square-matrix? v)  boolean?

  v : any/c

procedure

(row-matrix? v)  boolean?

  v : any/c

procedure

(col-matrix? v)  boolean?

  v : any/c
Like math:array?, math:mutable-array?, math:matrix?, math:square-matrix?, math:row-matrix?, and math:col-matrix?, respectively, but for this library’s monomorphic-wrapped arrays instead.

struct

(struct ImmArray (contents))

  contents : (math:Array typed:Real)

struct

(struct MutArray (contents))

  contents : (math:Mutable-Array typed:Real)
Monomorphic wrapper structs around the math library’s arrays and matrices.

procedure

(Array-contents a)  (math:Array typed:Real)

  a : array?
Gets the underlying math/array array from the wrapper.

syntax

(array #[#[...] ...])

syntax

(mutable-array #[#[...] ...])

syntax

(matrix [[element-expr ...] ...])

syntax

(col-matrix [element-expr ...])

syntax

(row-matrix [element-expr ...])

syntax

(for/matrix numrows-expr numcols-expr (for-clause ...) body ...+)

syntax

(for*/matrix numrows-expr numcols-expr (for-clause ...) body ...+)

procedure

(matrix11->value matrix?)  real?

  matrix? : m
Extracts the single value from a 1x1 matrix.

procedure

(array->immutable-array array?)  array?

  array? : a
Converts an array into an immutable array.

procedure

(make-mutable-matrix m n fill)  matrix?

  m : exact-nonnegative-integer?
  n : exact-nonnegative-integer?
  fill : real?
Creates a mutable matrix of shape m by n filled with initial value fill.

procedure

(matrix-set! m i j value)  void?

  m : matrix?
  i : exact-nonnegative-integer?
  j : exact-nonnegative-integer?
  value : real?
Sets the entry of m at row i and column j to be value.

procedure

(matrix-symmetric? m)  boolean?

  m : matrix?
Returns #t if m is a square, symmetric matrix, #f otherwise.

procedure

(array-sqrt/nan a)  array?

  a : array?

procedure

(array-sqrt/err a)  array?

  a : array?
Like math:array-sqrt, but for negative entries either returns +nan.0 or raises an error, so as to avoid producing an array of complex numbers.

procedure

(matrix-cholesky m)  matrix?

  m : matrix?
Given a symmetric, positive-definite matrix A, returns a lower-triangular matrix L such that (matrix* L (matrix-transpose L)) is equal to A.

If the Cholesky decomposition cannot be calculated, the function raises an error.

procedure

(matrix-ldl m)  
matrix? (vectorof real?)
  m : matrix?
Given a symmetric, positive-definite matrix A, returns the LDL decomposition, consisting of a lower-triangular matrix and a diagonal matrix.

6.6 Miscellaneous Utilities

procedure

(probability? v)  boolean?

  v : any/c
Returns #t if v is a real number between 0 and 1 (inclusive), #f otherwise.

parameter

(verbose?)  boolean?

(verbose? v?)  void?
  v? : boolean?
Parameter that controls whether informative messages are printed by solvers and ERPs.

procedure

(repeat thunk n)  list?

  thunk : (-> any/c)
  n : exact-nonnegative-integer?
Calls thunk n times, accumulating the results in a list.

Example:

> (repeat flip 10)

'(#f #t #f #t #t #t #t #f #t #f)

procedure

(indicator value-or-pred)  (-> any/c (or/c 1 0))

  value-or-pred : (or/c (-> any/c) any/c)

procedure

(indicator/value value)  (-> any/c (or/c 1 0))

  value : any/c

procedure

(indicator/predicate pred)  (-> any/c (or/c 1 0))

  pred : (-> any/c boolean?)
Produces an indicator function for the value value or the set of values accepted by the predicate pred, respectively.

Examples:

> (define zero (indicator 0))
> (zero 0)

1

> (zero 2.74)

0

> (zero 'apple)

0

> (define pos (indicator positive?))
> (pos 0)

0

> (pos -2.3)

0

> (pos 4.5)

1

procedure

(resample samples weights [n #:alg algorithm])  vector?

  samples : vector?
  weights : (vectorof (>=/c 0))
  n : exact-nonnegative-integer? = (vector-length samples)
  algorithm : (or/c 'multinomial 'residual #f) = 'multinomial
Resamples n values from samples with corresponding weights given by weights.