--- a
+++ b/R/custom_priors.R
@@ -0,0 +1,222 @@
+
+#' Customise priors for outbreaker
+#'
+#' Priors can be specified in several ways in outbreaker2 (see details and
+#' examples). The most flexible way to specify a prior is to provide a prior
+#' function directly. This function must take an argument 'param', which is a
+#' list which contains all the states of the parameters and augmented data. See
+#' the documentation of \link{create_param} for more information.
+#'
+#' @details
+#' There are three ways a user can specify priors:\cr
+#'
+#' 1) Default: this is what happens when the 'config' has default values of
+#' prior parameters.\cr
+
+#' 2) Customized parameters: in this case, the prior functions are the default
+#' ones from the package, but will use custom parameters, specified by the user
+#' through \code{\link{create_config}}.\cr
+#'
+#' 3) Customized functions: in this case, prior functions themselves are
+#' specified by the user, through the '...' argument of 'custom_priors'. The
+#' requirements is that such functions must have either hard-coded parameters or
+#' enclosed values. They will take a single argument which is a list containing
+#' all model parameters with the class 'outbreaker_param'. ALL PRIORS functions
+#' are expected to return values on a LOG SCALE.\cr
+#'
+#' Priors currently used for the model are:
+#' \itemize{
+#'
+#' \item \code{mu} (mutation rate): default function is an exponential
+#' distribution implemented in \code{outbreaker:::cpp_prior_mu}. New prior
+#' functions should use \code{x$mu} to refer to the current value of \code{mu},
+#' assuming their argument is called \code{x}.
+#'
+#' \item \code{pi} (reporting probability): default function is a beta
+#' distribution implemented in \code{outbreaker:::cpp_prior_pi}. New prior
+#' functions should use \code{x$pi} to refer to the current value of \code{pi},
+#' assuming their argument is called \code{x}.
+#'
+#' \item \code{eps} (contact reporting coverage): default function is a beta
+#' distribution implemented in \code{outbreaker:::cpp_prior_eps}. New prior
+#' functions should use \code{x$eps} to refer to the current value of \code{eps},
+#' assuming their argument is called \code{x}.
+#'
+#' \item \code{lambda} (non-infectious contact rate): default function is a
+#' beta distribution implemented in \code{outbreaker:::cpp_prior_lambda}. New
+#' prior functions should use \code{x$lambda} to refer to the current value of
+#' \code{lambda}, assuming their argument is called \code{x}.
+#'
+#' }
+#'
+#' @author Thibaut Jombart (\email{thibautjombart@@gmail.com}).
+#'
+#' @export
+#'
+#' @param ... A list or a series of named, comma-separated functions
+#'     implementing priors. Each function must have a single argument, which
+#'     corresponds to a 'outbreaker_param' list.
+#'
+#' @return A list of custom functions with class \code{custom_priors}. Values
+#'     set to \code{NULL} will be ignored and default functions will be used
+#'     instead.
+#'
+#' @seealso See \href{http://www.repidemicsconsortium.org/outbreaker2/articles/customisation.html#customising-priors}{customization vignette} for detailed examples on how to customize priors.
+#' 
+#' @examples
+#'
+#' ## BASIC CONFIGURATION
+#' custom_priors()
+#'
+#'
+#' ## SPECIFYING PRIOR PARAMETERS
+#' ## - this will need to be passed to outbreaker
+#' default_config <- create_config()
+#' new_config <- create_config(prior_mu = 1e-5,
+#'                         prior_pi = c(2, 1))
+#'
+#' ## - to check the prior manually, default settings:
+#' param <- list(mu = 0.001, pi = 0.9)
+#' outbreaker2:::cpp_prior_mu(param, default_config)
+#' outbreaker2:::cpp_prior_pi(param, default_config)
+#'
+#' outbreaker2:::cpp_prior_mu(param, new_config)
+#' outbreaker2:::cpp_prior_pi(param, new_config)
+#'
+#' ## these correspond to:
+#' dexp(0.001, 0.01, log = TRUE)
+#' dbeta(0.9, 2, 1, log = TRUE)
+#'
+#'
+#' ## SPECIFYING A PRIOR FUNCTION
+#'
+#' ## flat prior for pi between 0.5 and 1
+#' f <- function(x) {ifelse(x$pi > 0.5, log(2), log(0))}
+#' priors <- custom_priors(pi = f)
+#' priors # this should be passed to outbreaker
+#'
+#' ## test the prior manually
+#' priors$pi(list(pi=1))
+#' priors$pi(list(pi=.6))
+#' priors$pi(list(pi=.2))
+#' priors$pi(list(pi=.49))
+#'
+
+custom_priors <- function(...) {
+
+    ## This function returns a list of functions with the class
+    ## 'outbreaker_priors'. It is used to process custom priors passed by the
+    ## user. Each item of the list will be a prior function. If not provided,
+    ## the default value is 'NULL', in which case c++ priors will have the
+    ## default behaviour. This function tests some basic properties of the prior
+    ## functions:
+
+    ## 1) that if not NULL, the prior is a function
+
+    ## 2) that if a function, it has a single argument called 'param'
+
+
+
+    ## Get user-specified prior functions
+
+    priors <- list(...)
+    if (length(priors) == 1L && is.list(priors[[1]])) {
+        priors <- priors[[1]]
+    }
+
+
+    ## Use user-provided priors where provided, default otherwise. The default
+    ## for a prior is NULL, in which case the movement functions in C++ will use
+    ## C++ versions.
+
+    defaults <- list(mu = NULL, # mutation rate
+                     pi = NULL, # reporting probability
+                     eps = NULL, # contact reporting coverage
+                     lambda = NULL # non-infectious contact rate
+                     )
+
+    priors <- modify_defaults(defaults, priors, FALSE)
+    priors_names <- names(priors)
+
+
+
+    ## check all priors are functions
+
+    function_or_null <- function(x) {
+        is.null(x) || is.function(x)
+    }
+
+    is_ok <- vapply(priors, function_or_null, logical(1))
+
+    if (!all(is_ok)) {
+        culprits <- priors_names[!is_ok]
+        msg <- paste0("The following priors are not functions: ",
+                      paste(culprits, collapse = ", "))
+        stop(msg)
+    }
+
+
+    ## check they all have a single argument
+
+    with_one_arg <- function(x) {
+        if(is.function(x)) {
+            return (length(methods::formalArgs(x)) == 1L)
+        }
+
+        return(TRUE)
+    }
+
+    one_arg <- vapply(priors, with_one_arg, logical(1))
+
+    if (!all(one_arg)) {
+        culprits <- priors_names[!one_arg]
+        msg <- paste0("The following priors dont' have a single argument: ",
+                      paste(culprits, collapse = ", "))
+        stop(msg)
+    }
+
+
+    class(priors) <- c("custom_priors", "list")
+    return(priors)
+}
+
+
+
+
+
+
+
+#' @rdname custom_priors
+#'
+#' @export
+#'
+#' @aliases print.custom_priors
+#'
+#' @param x an \code{outbreaker_config} object as returned by \code{create_config}.
+#'
+
+print.custom_priors <- function(x, ...) {
+    cat("\n\n ///// outbreaker custom priors ///\n")
+    cat("\nclass:", class(x))
+    cat("\nnumber of items:", length(x), "\n\n")
+
+    is_custom <- !vapply(x, is.null, FALSE)
+
+
+    names_default <- names(x)[!is_custom]
+    if (length(names_default) > 0) {
+        cat("/// custom priors set to NULL (default used) //\n")
+        print(x[!is_custom])
+   }
+
+
+    names_custom <- names(x)[is_custom]
+    if (length(names_custom) > 0) {
+        cat("/// custom priors //\n")
+        print(x[is_custom])
+    }
+
+    return(invisible(NULL))
+
+}
+