Add a custom R function or distribution to the BUGS language.

Source: R/extend_bugs.r

Add a custom R function or distribution to the BUGS language.

In the current version, the custom distributions can only be used for unobserved nodes.

biips_add_function(name, n_param, fun_dim, fun_eval,
  fun_check_param = function(...) TRUE, fun_is_discrete = function(...)
  FALSE)

biips_add_distribution(name, n_param, fun_dim, fun_sample,
  fun_check_param = function(...) TRUE, fun_is_discrete = function(...)
  FALSE)

Arguments

name	string. Name of the custom function that will be used in the BUGS model. must be a valid BUGS language function name.
n_param	integer. Number of arguments of the custom function or distribution.
fun_dim	custom R function returning the size vector of the output. It will be called when compiling the model. Its arguments are the dimension vectors of the inputs.
fun_eval	custom R function which evaluates the function. Its arguments are the parameters values.
fun_check_param	custom R function which checks if the argument values are valid. Its arguments are the parameters values. Returns a logical. (default returns TRUE)
fun_is_discrete	custom R function returning a logical that is TRUE if the output is discrete. Its arguments are logicals indicating if the arguments are discrete. (default returns FALSE) All the given R functions must have the same number of input arguments.
fun_sample	custom R function which samples from the distribution. Its arguments are the parameters values.

Value

NULL

See also

biips_model

Examples

#' # Add custom functions and distributions to BUGS language
#' Add custom function `f`
f_dim <- function(x_dim, t_dim) {
  # Check dimensions of the input and return dimension of the output of function f
  stopifnot(prod(x_dim) == 1, prod(t_dim) == 1)
  x_dim
}
f_eval <- function(x, t) {
  # Evaluate function f
  0.5 * x + 25 * x/(1 + x^2) + 8 * cos(1.2 * t)
}
biips_add_function('f', 2, f_dim, f_eval)
#> * Added function f 

#' Add custom sampling distribution `dMN`
dMN_dim <- function(mu_dim, Sig_dim) {
  # Check dimensions of the input and return dimension of the output of
  # distribution dMN
  stopifnot(prod(mu_dim) == mu_dim[1], length(Sig_dim) == 2, mu_dim[1] == Sig_dim)
  mu_dim
}
dMN_sample <- function(mu, Sig) {
  # Draw a sample of distribution dMN
  mu + t(chol(Sig)) %*% rnorm(length(mu))
}
biips_add_distribution('dMN', 2, dMN_dim, dMN_sample)
#> * Added distribution dMN 

#' # Compile model
modelfile <- system.file('extdata', 'hmm_f.bug', package = 'rbiips')
stopifnot(nchar(modelfile) > 0)
cat(readLines(modelfile), sep = '\n')
#> var c_true[tmax], x_true[tmax], c[tmax], x[tmax], y[tmax]
#> 
#> data
#> {
#>   x_true[1] ~ dnorm(0, 1/5)
#>   y[1] ~ dnorm(x_true[1], exp(logtau_true))
#>   for (t in 2:tmax)
#>   {
#>     c_true[t] ~ dcat(p)
#>     x_true[t] ~ dnorm(f(x_true[t-1], t-1), ifelse(c_true[t]==1, 1/10, 1/100))
#>     y[t] ~ dnorm(x_true[t]/4, exp(logtau_true))
#>   }
#> }
#> 
#> model
#> {
#>   logtau ~ dunif(-3, 3)
#>   x[1] ~ dnorm(0, 1/5)
#>   y[1] ~ dnorm(x[1], exp(logtau))
#>   for (t in 2:tmax)
#>   {
#>     c[t] ~ dcat(p)
#>     x[t] ~ dnorm(f(x[t-1], t-1), ifelse(c[t]==1, 1/10, 1/100))
#>     y[t] ~ dnorm(x[t]/4, exp(logtau))
#>   }
#> }

data <- list(tmax = 10, p = c(.5, .5), logtau_true = log(1), logtau = log(1))
model <- biips_model(modelfile, data, sample_data = TRUE)
#> * Parsing model in: /home/adrien/Dropbox/workspace/rbiips/inst/extdata/hmm_f.bug
#> * Compiling data graph
#>   Declaring variables
#>   Resolving undeclared variables
#>   Allocating nodes
#>   Graph size: 94
#>   Sampling data
#>   Reading data back into data table
#> * Compiling model graph
#>   Declaring variables
#>   Resolving undeclared variables
#>   Allocating nodes
#>   Graph size: 105