Merge pull request #23 from venpopov/develop

Merge new `bmm` version

DESCRIPTION

@@ -1,15 +1,19 @@
 Package: bmm
 Title: Easy and Accesible Bayesian Measurement Models using 'brms'
-Version: 0.3.9.9000
+Version: 0.4.0.9000
 Authors@R: c(
     person("Vencislav", "Popov", , "[email protected]", role = c("aut", "cre", "cph")),
-    person("Gidon", "Frischkorn", , "[email protected]", role = c("aut", "cph")))
-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).
-License: GPL (>= 3)
+    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: 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)
 RoxygenNote: 7.3.1
@@ -41,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

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

NEWS.md

@@ -1,4 +1,6 @@
-# bmm 0.3.0+
+# bmm 0.4.0+
+
+# bmm 0.4.0
 
 ### New features
 
@@ -8,6 +10,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,126 @@ 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. **Default: "check"**
+#' @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()`. **Default:
+#'   FALSE**
+#' @param default_priors logical. If TRUE (default), the default bmm priors will
+#'   be used. If FALSE, only the basic `brms` priors will be used. **Default:
+#'   TRUE**
+#' @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. **Default: 1**
+#' @param reset_options logical. If TRUE, the options will be reset to their
+#'   default values **Default: FALSE**
+#' @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.
+#' @examples
+#'
+#' # view the current options
+#' bmm_options()
+#'
+#' # change the options to always sort the data and to use parallel sampling
+#' bmm_options(sort_data = TRUE, parallel = TRUE)
+#'
+#' # restore the default options
+#' bmm_options(reset_options = TRUE)
+#'
+#' # you can change the options using the options() function as well
+#' options(bmm.sort_data = TRUE, bmm.parallel = TRUE)
+#' bmm_options()
+#'
+#' # reset the options to their default values
+#' bmm_options(reset_options = TRUE)
+#'
+#' # bmm_options(sort_data = TRUE, parallel = TRUE) will also return the old options
+#' # so you can use it with on.exit()
+#' old_op <- bmm_options(sort_data = TRUE, parallel = TRUE)
+#' on.exit(bmm_options(old_op))
+#'
+#' @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 vignette(package=\"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)
+    }
+  }
+}

README.Rmd

@@ -11,6 +11,7 @@ knitr::opts_chunk$set(
 )
 ```
 # bmm   <!-- badges: start -->
+[![bmm status badge](https://popov-lab.r-universe.dev/badges/bmm)](https://popov-lab.r-universe.dev/bmm)
 [![R-CMD-check](https://github.com/venpopov/bmm/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/venpopov/bmm/actions/workflows/R-CMD-check.yaml)
 [![test-coverage](https://github.com/venpopov/bmm/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/venpopov/bmm/actions/workflows/test-coverage.yaml)
 <!-- badges: end -->
@@ -97,16 +98,13 @@ compiler. If you have not used `brms` before, you will need to first install the
 If you are already using `brms`, you are good to go and can
 install the package as described in one of the options below:
 
-<details>
+<details open>
 <summary><b>Install the latest beta release of bmm</b></summary>
 
 </br>
 
 ``` r
-if (!requireNamespace("remotes")) {
-  install.packages("remotes")
-}
-remotes::install_github("venpopov/bmm@*release")
+install.packages('bmm', repos = c('https://popov-lab.r-universe.dev'))
 ```
 
 This does not install the vignettes, which take a long time to build,

README.md

@@ -3,6 +3,8 @@
 
 # bmm <!-- badges: start -->
 
+[![bmm status
+badge](https://popov-lab.r-universe.dev/badges/bmm)](https://popov-lab.r-universe.dev/bmm)
 [![R-CMD-check](https://github.com/venpopov/bmm/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/venpopov/bmm/actions/workflows/R-CMD-check.yaml)
 [![test-coverage](https://github.com/venpopov/bmm/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/venpopov/bmm/actions/workflows/test-coverage.yaml)
 <!-- badges: end -->
@@ -65,11 +67,11 @@ view the latest list of supported models by running:
 bmm::supported_models()
 #> The following models are supported:
 #> 
-#> -  IMMabc(resp_err, nt_features, setsize) 
-#> -  IMMbsc(resp_err, nt_features, nt_distances, setsize) 
-#> -  IMMfull(resp_err, nt_features, nt_distances, setsize) 
+#> -  IMMabc(resp_err, nt_features, setsize, regex) 
+#> -  IMMbsc(resp_err, nt_features, nt_distances, setsize, regex) 
+#> -  IMMfull(resp_err, nt_features, nt_distances, setsize, regex) 
 #> -  mixture2p(resp_err) 
-#> -  mixture3p(resp_err, nt_features, setsize) 
+#> -  mixture3p(resp_err, nt_features, setsize, regex) 
 #> -  sdmSimple(resp_err) 
 #> 
 #> Type  ?modelname  to get information about a specific model, e.g.  ?IMMfull
@@ -108,18 +110,15 @@ this step.
 If you are already using `brms`, you are good to go and can install the
 package as described in one of the options below:
 
-<details>
+<details open>
 <summary>
 <b>Install the latest beta release of bmm</b>
 </summary>
 
 </br>
 
 ``` r
-if (!requireNamespace("remotes")) {
-  install.packages("remotes")
-}
-remotes::install_github("venpopov/bmm@*release")
+install.packages('bmm', repos = c('https://popov-lab.r-universe.dev'))
 ```
 
 This does not install the vignettes, which take a long time to build,

_pkgdown.yml

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