Allow partial overrides of control.* parameters

R/bru.inference.R

@@ -287,35 +287,49 @@ stackmaker.like = function(lhood) {
 }
 
 
+
+
+
 #' Additional \link{bru} options
 #'
 #' @aliases bru.options
 #' @export
-#' 
-#' @param mesh An \code{inla.mesh} object for spatial models without SPDE components. Mostly used for successive spatial predictions.
-#' @param run If TRUE, run inference. Otherwise only return configuration needed to run inference.
+#'
+#' @param mesh An \code{inla.mesh} object for spatial models without SPDE
+#'   components. Mostly used for successive spatial predictions.
+#' @param run If TRUE, run inference. Otherwise only return configuration needed
+#'   to run inference.
 #' @param max.iter maximum number of inla iterations
-#' @param offset the usual \link[INLA]{inla} offset. If a nonlinear formula is used, the resulting Taylor approximation constant will be added to this automatically.
-#' @param result An \code{inla} object returned from previous calls of \link[INLA]{inla}, \link{bru} or \link{lgcp}. This will be used as a starting point for further improvement of the approximate posterior.
+#' @param offset the usual \link[INLA]{inla} offset. If a nonlinear formula is
+#'   used, the resulting Taylor approximation constant will be added to this
+#'   automatically.
+#' @param result An \code{inla} object returned from previous calls of
+#'   \link[INLA]{inla}, \link{bru} or \link{lgcp}. This will be used as a
+#'   starting point for further improvement of the approximate posterior.
 #' @param E \link[INLA]{inla} 'poisson' likelihood exposure parameter
 #' @param Ntrials \link[INLA]{inla} 'binomial' likelihood parameter
 #' @param control.compute INLA option, See \link[INLA]{control.compute}
 #' @param control.inla INLA option, See \link[INLA]{control.inla}
-#' @param control.fixed INLA option, See \link[INLA]{control.fixed}
+#' @param control.fixed INLA option, See \link[INLA]{control.fixed}. Warning:
+#'   due to how inlabru currently constructs the \code{inla()}, the \code{mean},
+#'   \code{prec}, \code{mean.intercept}, and \code{prec.intercept} will have no
+#'   effect. Until a more elegant alterative has been implemented, use explicit
+#'   \code{mean.linear} and \code{prec.linear} specifications in each
+#'   \code{model="linear"} component instead.
 #' @param ... Additional options passed on to \link[INLA]{inla}
-#' 
-#' @author Fabian E. Bachl <\email{bachlfab@@gmail.com}>
-#' 
+#'
+#' @author Fabian E. Bachl <\email{bachlfab@@gmail.com}> and Finn Lindgren \email{finn.lindgren@@gmail.com}
+#'
 #' @examples
-#' 
+#'
 #' \donttest{
-#' 
+#'
 #' # Generate default bru options
 #' opts = bru.options()
 #'
 #' # Print them:
 #' opts
-#' 
+#'
 #' }
 #' 
 bru.options = function(mesh = NULL, 
@@ -325,12 +339,21 @@ bru.options = function(mesh = NULL,
                        result = NULL, 
                        E = 1,
                        Ntrials = 1,
-                       control.compute = inlabru:::iinla.getOption("control.compute"),
-                       control.inla = inlabru:::iinla.getOption("control.inla"),
-                       control.fixed = inlabru:::iinla.getOption("control.fixed"),
+                       control.compute = list(),
+                       control.inla = list(),
+                       control.fixed = list(),
                        ... )
 {
-
+  control.compute <-
+    override_config_defaults(control.compute,
+                             iinla.getOption("control.compute"))
+  control.inla <-
+    override_config_defaults(control.inla,
+                             iinla.getOption("control.inla"))
+  control.fixed <-
+    override_config_defaults(control.fixed,
+                             iinla.getOption("control.fixed"))
+
   args <- as.list(environment())
   args$control.compute = NULL
   args$control.inla = NULL

R/environment.R

@@ -82,68 +82,122 @@ msg = function(txt) {
 
 logentry = function(txt) { iinla.env$log = c(iinla.env$log, paste0(Sys.time(),": ", txt)) }
 
-iinla.getOption = function (option = c("control.compute",
-                                       "control.inla",
-                                       "iinla.verbose",
-                                       "control.fixed")) 
+#' Merge defaults with overriding options
+#'
+#' Helper function for setting option variables and lists.
+#' 
+#' @details
+#' \itemize{
+#'   \item Atomic values override defaults.
+#'   \item \code{NULL} values are replaced by defaults.
+#'   \item Missing elements of an option list are set to the default values.
+#' }
+#' 
+#' @param options An atomic element or a list with named entries.
+#' @param defaults An atomic element or a list with named entries.
+#' @return The merged option(s).
+#' 
+#' @keywords internal
+#' @author Finn Lindgren \email{finn.lindgren@@gmail.com}
+#' 
+#' @examples
+#' def <- list(iterations = 10, method = "newton")
+#' override_config_defaults(list(iterations = 20, verbose = TRUE), def)
+
+override_config_defaults <- function(options, defaults)
 {
-  if (missing(option)) 
-    stop("argument is required.")
-  envir = iinla.env
-  option = match.arg(option, several.ok = TRUE)
-  if (exists("iinla.options", envir = envir)) 
-    opt = get("iinla.options", envir = envir)
-  else opt = list()
+  if (is.null(options)) {
+    return(defaults)
+  }
+  if (!is.list(options)) {
+    return(options)
+  }
+  for (name in names(options)) {
+    defaults[[name]] = options[[name]]
+  }
+  defaults
+}
 
-  default.opt = list(iinla.verbose = FALSE,
-                     control.compute = list(config = TRUE, dic = TRUE, waic = TRUE),
-                     control.inla = list(int.strategy = "auto"),
-                     control.fixed = list(expand.factor.strategy = "inla"))
-  res = c()
+iinla.getOption <- function(
+  option = c(
+    "control.compute",
+    "control.inla",
+    "iinla.verbose",
+    "control.fixed"
+  ))
+{
+  if (missing(option)) {
+    stop("argument is required.")
+  }
+  envir <- iinla.env
+  option <- match.arg(option, several.ok = TRUE)
+  if (exists("iinla.options", envir = envir)) {
+    opt <- get("iinla.options", envir = envir)
+  } else {
+    opt <- list()
+  }
+
+  default.opt <-
+    list(
+      iinla.verbose = FALSE,
+      control.compute = list(config = TRUE, dic = TRUE, waic = TRUE),
+      control.inla = list(int.strategy = "auto"),
+      control.fixed = list(expand.factor.strategy = "inla")
+    )
+  res <- c()
   for (i in 1:length(option)) {
     if (option[i] %in% names(opt)) {
-      res[[option[i]]] = opt[[option[i]]]
-    }
-    else {
-      res[[option[i]]] = default.opt[[option[i]]]
+      res[[option[i]]] <- override_config_defaults(
+        opt[[option[i]]],
+        default.opt[[option[i]]]
+      )
+    } else {
+      res[[option[i]]] <- default.opt[[option[i]]]
     }
   }
-  if (length(res) == 1) { res = res[[1]] }
+  if (length(res) == 1) {
+    res <- res[[1]]
+  }
   return(res)
 }
 
 
-
-iinla.setOption = function (...) 
-{
-  iinla.setOption.core = function(option = c("control.compute",
-                                             "control.inla",
-                                             "iinla.verbose",
-                                             "control.fixed"), value) {
-    envir = iinla.env
-    option = match.arg(option, several.ok = FALSE)
-    if (!exists("iinla.options", envir = envir)) 
+iinla.setOption <- function(...) {
+  iinla.setOption.core <- function(option = c(
+                                       "control.compute",
+                                       "control.inla",
+                                       "iinla.verbose",
+                                       "control.fixed"
+                                     ),
+                                     value) {
+    envir <- iinla.env
+    option <- match.arg(option, several.ok = FALSE)
+    if (!exists("iinla.options", envir = envir)) {
       assign("iinla.options", list(), envir = envir)
-    if (is.character(value)) {
-      eval(parse(text = paste("iinla.options$", option, 
-                              "=", shQuote(value), sep = "")), envir = envir)
     }
-    else {
-      eval(parse(text = paste("iinla.options$", option, 
-                              "=", ifelse(is.null(value), "NULL", value), 
-                              sep = "")), envir = envir)
+    if (is.character(value)) {
+      eval(parse(text = paste("iinla.options$", option,
+                              "=", shQuote(value),
+                              sep = ""
+      )), envir = envir)
+    } else {
+      eval(parse(text = paste("iinla.options$", option,
+                              "=", ifelse(is.null(value), "NULL", value),
+                              sep = ""
+      )), envir = envir)
     }
     return(invisible())
   }
-  called = list(...)
-  len = length(names(called))
+  called <- list(...)
+  len <- length(names(called))
   if (len > 0L) {
     for (i in 1L:len) {
-      do.call(iinla.setOption.core, args = list(names(called)[i], 
-                                               called[[i]]))
+      do.call(iinla.setOption.core, args = list(
+        names(called)[i],
+        called[[i]]
+      ))
     }
-  }
-  else {
+  } else {
     iinla.setOption.core(...)
   }
   return(invisible())