improve package loading times (#211)

Co-authored-by: Gidon Frischkorn <[email protected]>
venpopov · May 21, 2024 · 6c3eedd · 6c3eedd
1 parent 90c961f
commit 6c3eedd
Show file tree

Hide file tree

Showing 14 changed files with 63 additions and 36 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -45,13 +45,13 @@ Imports:
     matrixStats,
     crayon,
     methods,
-    fs
+    fs,
+    brms (>= 2.21.0)
 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/
 VignetteBuilder: knitr
 Depends: 
-    R (>= 3.6.0),
-    brms (>= 2.21.0)
+    R (>= 3.6.0)
 LazyData: true
diff --git a/NAMESPACE b/NAMESPACE
@@ -30,7 +30,6 @@ S3method(configure_prior,imm_abc)
 S3method(configure_prior,imm_bsc)
 S3method(configure_prior,imm_full)
 S3method(configure_prior,mixture3p)
-S3method(default_prior,bmmformula)
 S3method(fit_info,brmsfit)
 S3method(fit_info,brmsfit_list)
 S3method(identical,bmmformula)
@@ -54,13 +53,10 @@ S3method(reset_env,brmsfamily)
 S3method(reset_env,brmsformula)
 S3method(reset_env,default)
 S3method(reset_env,formula)
-S3method(restructure,bmmfit)
 S3method(revert_postprocess_brm,default)
 S3method(revert_postprocess_brm,sdm)
 S3method(rhs_vars,bmmformula)
 S3method(rhs_vars,formula)
-S3method(stancode,bmmformula)
-S3method(standata,bmmformula)
 S3method(summarise_model,bmmodel)
 S3method(summary,bmmfit)
 S3method(update,bmmfit)
@@ -79,6 +75,8 @@ export(calc_error_relative_to_nontargets)
 export(check_data)
 export(configure_model)
 export(configure_prior)
+export(default_prior)
+export(default_prior.bmmformula)
 export(deg2rad)
 export(dimm)
 export(dmixture2p)
@@ -101,6 +99,8 @@ export(qmixture2p)
 export(qmixture3p)
 export(qsdm)
 export(rad2deg)
+export(restructure)
+export(restructure.bmmfit)
 export(revert_postprocess_brm)
 export(rimm)
 export(rmixture2p)
@@ -110,14 +110,14 @@ export(sdm)
 export(sdmSimple)
 export(softmax)
 export(softmaxinv)
+export(stancode)
+export(stancode.bmmformula)
+export(standata)
+export(standata.bmmformula)
 export(supported_models)
 export(use_model_template)
 export(wrap)
 import(stats)
-importFrom(brms,default_prior)
-importFrom(brms,restructure)
-importFrom(brms,stancode)
-importFrom(brms,standata)
 importFrom(glue,glue)
 importFrom(magrittr,"%>%")
 importFrom(utils,packageVersion)
diff --git a/NEWS.md b/NEWS.md
@@ -11,6 +11,9 @@
 ### Deprecated functions and arguments
 * BREAKING CHANGE: the arguments for the distribution functions of the  **mixture2p** and **mixture3p** model have been change to match the snake_case coding scheme. Instead of *pMem* and **pNT** these are now **p_mem** and **p_nt**. The old names are deprecated and are no longer supported
 
+### Other changes
+* improve package loading speed
+
 # bmm 0.5.1
 
 ### Bug fixes

diff --git a/R/helpers-data.R b/R/helpers-data.R
@@ -222,6 +222,7 @@ rad2deg <- function(rad){
 #'   `brms`
 #'
 #' @inheritParams bmm
+#' @aliases standata
 #' @param object A `bmmformula` object
 #' @param ... Further arguments passed to [brms::standata()]. See the
 #'   description of [brms::standata()] for more details
@@ -231,16 +232,13 @@ rad2deg <- function(rad){
 #'
 #' @seealso [supported_models()], [brms::standata()]
 #'
-#' @export
-#'
 #' @keywords extract_info
 #'
 #' @examples
 #' sdata1 <- standata(bmf(c ~ 1, kappa ~ 1),
 #'                    data = oberauer_lin_2017,
 #'                    model = sdm(resp_error = "dev_rad"))
 #' str(sdata1)
-#' @importFrom brms standata
 #' @export
 standata.bmmformula <- function(object, data, model, prior = NULL, ...) {
   # check model, formula and data, and transform data if necessary
@@ -264,6 +262,11 @@ standata.bmmformula <- function(object, data, model, prior = NULL, ...) {
   brms::do_call(brms::standata, fit_args)
 }
 
+#' @export
+standata <- function(object, ...) {
+  brms::standata(object, ...)
+}
+
 # check if the data is sorted by the predictors
 is_data_ordered <- function(data, formula) {
   dpars <- names(formula)

diff --git a/R/helpers-model.R b/R/helpers-model.R
@@ -609,6 +609,7 @@ use_model_template <- function(model_name,
 #'   `brms`
 #'
 #' @inheritParams bmm
+#' @aliases stancode
 #' @param object A `bmmformula` object
 #' @param ... Further arguments passed to [brms::stancode()]. See the
 #'   description of [brms::stancode()] for more details
@@ -623,7 +624,6 @@ use_model_template <- function(model_name,
 #'                    data = oberauer_lin_2017,
 #'                    model = sdm(resp_error = "dev_rad"))
 #' cat(scode1)
-#' @importFrom brms stancode
 #' @export
 stancode.bmmformula <- function(object, data, model, prior = NULL, ...) {
   withr::local_options(bmm.sort_data = FALSE)
@@ -649,6 +649,11 @@ stancode.bmmformula <- function(object, data, model, prior = NULL, ...) {
   add_bmm_version_to_stancode(code)
 }
 
+#' @export
+stancode <- function(object, ...) {
+  brms::stancode(object, ...)
+}
+
 
 add_bmm_version_to_stancode <- function(stancode) {
   version <- packageVersion("bmm")

diff --git a/R/helpers-prior.R b/R/helpers-prior.R
@@ -12,6 +12,7 @@
 #'   priors in `brms`, as we use domain knowledge to specify the priors.
 #'
 #' @inheritParams bmm
+#' @aliases default_prior
 #' @param object A `bmmformula` object
 #' @param ... Further arguments passed to [brms::default_prior()]
 #'
@@ -24,13 +25,10 @@
 #'
 #' @keywords extract_info
 #'
-#' @export
-#'
 #' @examples
 #' default_prior(bmf(c ~ 1, kappa ~ 1),
 #'               data = oberauer_lin_2017,
 #'               model = sdm(resp_error = 'dev_rad'))
-#' @importFrom brms default_prior
 #' @export
 default_prior.bmmformula <- function(object, data, model, formula = object, ...) {
   withr::local_options(bmm.sort_data = FALSE)
@@ -52,6 +50,11 @@ default_prior.bmmformula <- function(object, data, model, formula = object, ...)
   combine_prior(brms_priors, prior_args$prior)
 }
 
+#' @export
+default_prior <- function(object, ...) {
+  brms::default_prior(object, ...)
+}
+
 
 #' @title construct constant priors to fix fixed model parameters
 #' @param model a `bmmodel` object

diff --git a/R/restructure.R b/R/restructure.R
@@ -4,6 +4,8 @@
 #' the latest \pkg{bmm} version. This function is called
 #' internally when applying post-processing methods.
 #'
+#' @aliases restructure
+#' 
 #' @param x An object of class \code{bmmfit}.
 #' @param ... Currently ignored.
 #'
@@ -12,7 +14,6 @@
 #' @keywords transform
 #' @export
 #' @importFrom utils packageVersion
-#' @importFrom brms restructure
 restructure.bmmfit <- function(x, ...) {
   version <- x$version$bmm
   if (is.null(version)) {
@@ -84,6 +85,11 @@ restructure.bmmfit <- function(x, ...) {
   NextMethod('restructure')
 }
 
+#' @export
+restructure <- function(object, ...) {
+  brms::restructure(object, ...)
+}
+
 restructure_version.bmm <- function(x) {
   out <- x$version$bmm_restructure
   if (!is.package_version(out)) {

diff --git a/R/zzz.R b/R/zzz.R
@@ -3,30 +3,31 @@
 }
 
 .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")
+  local_version <- utils::packageVersion("bmm")
+  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")
+    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 (interactive() && !isFALSE(as.logical(Sys.getenv("BMM_CHECK_CRAN_VERSION")))) {
+    # 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"]
+    behind_cran <- cran_version > local_version
+
     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?")

diff --git a/man/default_prior.bmmformula.Rd b/man/default_prior.bmmformula.Rd
diff --git a/man/restructure.bmmfit.Rd b/man/restructure.bmmfit.Rd
diff --git a/man/stancode.bmmformula.Rd b/man/stancode.bmmformula.Rd
diff --git a/man/standata.bmmformula.Rd b/man/standata.bmmformula.Rd
diff --git a/tests/testthat/test-helpers-postprocess.R b/tests/testthat/test-helpers-postprocess.R
@@ -10,7 +10,7 @@ test_that("bmm version is added to mock model", {
 
 
 test_that("get_mu_pars works",{
-  a <- brm(y~ a, data.frame(y = c(1,2,3), a = c('A',"B","C")),
+  a <- brms::brm(y~ a, data.frame(y = c(1,2,3), a = c('A',"B","C")),
            backend = "mock", mock_fit = 1, rename=F)
   mus <- get_mu_pars(a)
   expect_equal(mus, c("Intercept", "aB", "aC"))

diff --git a/tests/testthat/test-update.R b/tests/testthat/test-update.R
@@ -1,3 +1,5 @@
+save_pars <- brms::save_pars
+
 test_that("update.bmmfit works", {
   skip_on_cran()
   fit1 <- restructure(bmmfit_example1)