Feature/117 add a message upon loading the package

DESCRIPTION

@@ -1,16 +1,18 @@
 Package: bmm
 Title: Easy and Accesible Bayesian Measurement Models using 'brms'
-Version: 0.3.9.9000
+Version: 0.3.10.9000
 Authors@R: c(
     person("Vencislav", "Popov", , "[email protected]", role = c("aut", "cre", "cph")),
     person("Gidon", "Frischkorn", , "[email protected]", role = c("aut", "cph")),
     person("Paul", "Bürkner", , "[email protected]", role = c("cph"), 
       comment = "Creator of brms, a package for Bayesian regression model that this package builds upon."))
-Description: Wrapper functions and custom distributions that make it easier to estimate common 
-    measurement models for using the 'brms' package. Currently implemented 
-    are the two-parameter mixture model by Zhang and Luck (2008),the three-
-    parameter mixture model by Bays et al (2009), and the Interference Measurement Model 
-    (Oberauer et al., 2017).
+Description: Implementations of computational measurement models using the 'brms' package. 
+    Currently implemented models can be listed using supported_models(). The package also
+    provides functions to extract model informations such as priors, or the generated
+    STAN code. For all implemented models there are also density and random generation
+    functions to easily explore model predictions and evaluate parameter recovery.
+    Finally, helper functions aid in pre- and post-processing data for efficient communication
+    of results.
 License: GPL-2
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
@@ -43,6 +45,9 @@ Imports:
     methods
 URL: https://github.com/venpopov/bmm, https://venpopov.github.io/bmm/
 BugReports: https://github.com/venpopov/bmm/issues
+Additional_repositories:
+    https://mc-stan.org/r-packages/
+    https://paul-buerkner.github.io/brms/
 VignetteBuilder: knitr
 Depends: 
     R (>= 2.10),

NAMESPACE

@@ -42,6 +42,7 @@ export(IMMbsc)
 export(IMMfull)
 export(bmf)
 export(bmf2bf)
+export(bmm_options)
 export(bmmformula)
 export(c_bessel2sqrtexp)
 export(c_sqrtexp2bessel)

NEWS.md

@@ -8,6 +8,8 @@
 * add informed default priors for all models. You can always use the `get_model_prior()` function to see the default priors for a model
 * add a new function `set_default_prior` for developers, which allows them to more easily set default priors on new models regardless of the user-specified formula
 * you can now specify variables for models via regular expressions rather than character vectors (#102)
+* you can now view and set all bmm global options via `bmm_options()`. See `?bmm_options` for more information
+* add a startup message upon loading the package 
 
 ### Bug fixes
 * fix a bug in the mixture3p and IMM models which caused an error when intercept was not supressed and set size was used as predictor

R/fit_model.R

@@ -26,10 +26,10 @@
 #'   fitting, but you can provide prior constraints to model parameters
 #' @param sort_data Logical. If TRUE, the data will be sorted by the predictor
 #'   variables for faster sampling. If FALSE, the data will not be sorted, but
-#'   sampling will be slower. If NULL (the default), `fit_model()` will check if
+#'   sampling will be slower. If "check" (the default), `fit_model()` will check if
 #'   the data is sorted, and ask you via a console prompt if it should be
 #'   sorted. You can set the default value for this option using global
-#'   `options(bmm.sort_data = TRUE/FALSE)`
+#'   `options(bmm.sort_data = TRUE/FALSE/"check)`)` or via `bmm_options(sort_data)`
 #' @param silent Verbosity level between 0 and 2. If 1 (the default), most of the
 #'   informational messages of compiler and sampler are suppressed. If 2, even
 #'   more messages are suppressed. The actual sampling progress is still
@@ -74,9 +74,13 @@
 #'                  backend='cmdstanr')
 #' }
 #'
-fit_model <- function(formula, data, model, parallel = FALSE, chains = 4,
-                      prior = NULL, sort_data = getOption('bmm.sort_data', NULL),
-                      silent = getOption('bmm.silent', 1), ...) {
+fit_model <- function(formula, data, model,
+                      prior = NULL,
+                      chains = 4,
+                      parallel = getOption('bmm.parallel', FALSE),
+                      sort_data = getOption('bmm.sort_data', "check"),
+                      silent = getOption('bmm.silent', 1),
+                      ...) {
   # warning for using old version
   dots <- list(...)
   if ("model_type" %in% names(dots)) {

R/utils.R

@@ -256,7 +256,7 @@ stop_quietly <- function() {
 # data is ordered by the predictor variables. This function checks if the data is
 # ordered by the predictors, and if not, it suggests to the user to sort the data
 order_data_query <- function(model, data, formula) {
-  sort_data <- getOption("bmm.sort_data", NULL)
+  sort_data <- getOption("bmm.sort_data", "check")
   dpars <- names(formula)
   predictors <- rhs_vars(formula)
   predictors <- predictors[not_in(predictors, dpars)]
@@ -382,3 +382,97 @@ identical.formula <- function(x, y, ...) {
   res <- waldo::compare(x, y, ignore_formula_env = TRUE)
   length(res) == 0
 }
+
+
+#' View or change global bmm options
+#' @param sort_data logical. If TRUE, the data will be sorted by the predictors. If
+#'  FALSE, the data will not be sorted, but sampling will be slower. If "check" (the
+#'  default), `fit_model()` will check if the data is sorted, and ask you via a
+#'  console prompt if it should be sorted.
+#' @param parallel logical. If TRUE, chains will be run in parallel. If FALSE, chains will
+#'  be run sequentially. You can also set these value for each model separately via
+#'  the argument `parallel` in `fit_model()`.
+#' @param default_priors logical. If TRUE (default), the default bmm priors will be used. If
+#'  FALSE, only the basic `brms` priors will be used.
+#' @param silent numeric. Verbosity level between 0 and 2. If 1 (the default), most of the
+#'  informational messages of compiler and sampler are suppressed. If 2, even
+#'  more messages are suppressed. The actual sampling progress is still printed.
+#' @param reset_options logical. If TRUE, the options will be reset to their default values
+#' @details The `bmm_options` function is used to view or change the current bmm
+#'  options. If no arguments are provided, the function will return the current
+#'  options. If arguments are provided, the function will change the options and
+#'  return the old options invisibly. If you provide only some of the arguments,
+#'  the other options will not be changed. The options are stored in the global options
+#'  list and will be used by `fit_model()` and other functions in the `bmm` package.
+#'  Each of these options can also be set manually using the built-in `options()` function,
+#'  by setting the `bmm.sort_data`, `bmm.default_priors`, and `bmm.silent` options.
+#' @return A message with the current bmm options and their values, and invisibly
+#'  returns the old options for use with on.exit() and friends.
+#' @export
+bmm_options <- function(sort_data, parallel, default_priors, silent, reset_options = FALSE) {
+  opts <- ls()
+  if (!missing(sort_data) && sort_data != "check" && !is.logical(sort_data)) {
+    stop2("sort_data must be one of TRUE, FALSE, or 'check'")
+  }
+  if (!missing(parallel) && !is.logical(parallel)) {
+    stop2("parallel must be one of TRUE or FALSE")
+  }
+  if (!missing(default_priors) && !is.logical(default_priors)) {
+    stop2("default_priors must be a TRUE or FALSE")
+  }
+  if (!missing(silent) && (!is.numeric(silent) || silent < 0 || silent > 2)) {
+    stop2("silent must be one of 0, 1, or 2")
+  }
+
+  # set default options if function is called for the first time or if reset_options is TRUE
+  if (reset_options) {
+    options(bmm.sort_data = "check",
+            bmm.parallel = FALSE,
+            bmm.default_priors = TRUE,
+            bmm.silent = 1)
+  }
+
+  # change options if arguments are provided. get argument name and loop over non-missing arguments
+  op <- list()
+  non_missing_args <- names(match.call())[-1]
+  non_missing_args <- non_missing_args[!non_missing_args %in% "reset_options"]
+  for (i in non_missing_args) {
+      op[[paste0('bmm.',i)]] <- get(i)
+  }
+
+  old_op <- options(op)
+  message2("\nCurrent bmm options:\n",
+           crayon::green(paste0("  sort_data = ", getOption("bmm.sort_data"),"",
+                                 "\n  parallel = ", getOption("bmm.parallel"),
+                                 "\n  default_priors = ", getOption("bmm.default_priors"),
+                                 "\n  silent = ", getOption("bmm.silent"), "\n")),
+           "For more information on these options or how to change them, see help(bmm_options).\n")
+  invisible(old_op)
+}
+
+# an improved version of tryCatch that captures messages as well
+# modified version of https://github.com/cran/admisc/blob/master/R/tryCatchWEM.R
+tryCatch2 <- function(expr, capture = FALSE) {
+  toreturn <- list()
+  output <- withVisible(withCallingHandlers(
+    tryCatch(expr, error = function(e) {
+      toreturn$error <<- e$message
+      NULL
+    }),
+    warning = function(w) {
+      toreturn$warning <<- c(toreturn$warning, w$message)
+      invokeRestart("muffleWarning")
+    },
+    message = function(m) {
+      toreturn$message <<- paste(toreturn$message, m$message, sep = "")
+      invokeRestart("muffleMessage")
+    }
+  ))
+  if (capture && output$visible && !is.null(output$value)) {
+    toreturn$output <- utils::capture.output(output$value)
+    toreturn$value <- output$value
+  }
+  if (length(toreturn) > 0) {
+    return(toreturn)
+  }
+}

R/zzz.R

@@ -0,0 +1,40 @@
+.onLoad <- function(libname, pkgname) {
+  suppressMessages(bmm_options(reset_options = TRUE))
+}
+
+.onAttach <- function(libname, pkgname) {
+  # test if local installation is behind CRAN
+  cran_pkgs <- utils::available.packages(repos = "http://cran.us.r-project.org")
+  cran_version <- cran_pkgs[which(cran_pkgs[,"Package"] == "bmm"),"Version"]
+  local_version <- utils::packageVersion("bmm")
+  behind_cran <- cran_version > local_version
+
+  # add banner of package
+  banner <- " _
+| |_ _____ _____
+| . |     |     |
+|___|_|_|_|_|_|_|
+"
+
+  versionMsg <- paste0("Loading bmm (version: ",local_version,").\n")
+
+  startUpMsg <- c(
+    paste0("A short introduction to package is available by calling help(\"bmm\"). \n",
+           "More detailed articles on how to fit different models are available via vignettes(\"bmm\").\n",
+           "You can view the list of currently available models by calling supported_models().\n")
+  )
+
+  optionsMsg <- tryCatch2(bmm_options())$message
+
+  if (interactive()) {
+    if (length(behind_cran) > 0 && behind_cran) {
+      msg <- "A newer version of bmm is available on CRAN."
+      packageStartupMessage(msg, "\nWould you like to install it?")
+      if (utils::menu(c("Yes", "No")) == 1) {
+        utils::update.packages("bmm")
+      }
+    } else {
+      packageStartupMessage(banner, versionMsg, startUpMsg, optionsMsg)
+    }
+  }
+}

_pkgdown.yml

@@ -30,6 +30,7 @@ reference:
  - contents:
    - "bmm"
    - "supported_models"
+   - "bmm_options"
  - title: "Fitting models"
    desc: "Main functions for model fitting"
  - contents:

tests/testthat/test-utils.R

@@ -41,3 +41,14 @@ test_that("get_variables works", {
   expect_equal(get_variables('a|b', c('a', 'b', 'c'), regex = FALSE), 'a|b')
   expect_error(get_variables('d', c('a', 'b', 'c'), regex = TRUE))
 })
+
+test_that("bmm_options works", {
+  withr::defer(suppressMessages(bmm_options()))
+  expect_message(bmm_options(), "Current bmm options")
+  expect_message(bmm_options(sort_data = TRUE), "sort_data = TRUE")
+  expect_equal(getOption('bmm.sort_data'), TRUE)
+  op <- suppressMessages(bmm_options(sort_data = FALSE))
+  expect_equal(getOption('bmm.sort_data'), FALSE)
+  options(op)
+  expect_equal(getOption('bmm.sort_data'), TRUE)
+})