diff --git a/.github/actions/build-src/action.yml b/.github/actions/build-src/action.yml index c0b032f9b..b16df8b36 100644 --- a/.github/actions/build-src/action.yml +++ b/.github/actions/build-src/action.yml @@ -8,48 +8,27 @@ inputs: runs: using: "composite" steps: - + - name: Determine system/package state run: | sink(".github/meta.txt") list( version = version, - pkgs = installed.packages()[c("Rcpp", "rstan", "rstantools"), c("Version", "Package")] + pkgs = installed.packages()[c("rstan"), c("Version", "Package")] ) sink() shell: Rscript {0} - - # The default R/stanmodels.R was updated in v2.2.0 (11Apr2022) - # Normally for older versions it would change itself on the fly - # when it compiles the stan model - # but as we are using cached models we are preventing compilation - # and thus need to manually refresh the file - - name: Refresh rstantools config files - shell: bash - run: | - echo "inputs.refresh = ${{ inputs.refresh }}" - if ${{ inputs.refresh }} ; then - Rscript -e "rstantools::rstan_config()" - fi - + - name: Cache Compiled Stan Code id: cache-pkgs uses: actions/cache@v3 with: - path: src/* + path: local/* key: ${{ hashFiles('.github/meta.txt') }}-${{ hashFiles('inst/stan/MMRM.stan') }} - - - # pkgbuild compares time stamps of *.so object to all header files including - # inst/include/stan_meta_header.hpp so we touch the .so object to push its time - # stamp beyond that of the .hpp file + - name: Build if needed shell: bash + env: + RBMI_CACHE_DIR: local run: | - if [[ ${{ steps.cache-pkgs.outputs.cache-hit == 'true' }} && "${{ runner.os }}" != "Windows" ]] ; then - echo "No compilation needed!" - touch src/*.so - else - echo "Compilation needed!" - Rscript -e "pkgbuild::compile_dll()" - fi + Rscript -e "pkgload::load_all(); get_stan_model()" diff --git a/.github/actions/rcmdcheck/action.yml b/.github/actions/rcmdcheck/action.yml index c673f57a4..35782cf6b 100644 --- a/.github/actions/rcmdcheck/action.yml +++ b/.github/actions/rcmdcheck/action.yml @@ -1,10 +1,6 @@ name: 'Build src' description: 'Build src!' -inputs: - slim: - description: 'Should the reduced set of checks be run' - default: false runs: using: "composite" steps: @@ -15,16 +11,12 @@ runs: - name: Run R CMD check env: + RBMI_CACHE_DIR: local _R_CHECK_CRAN_INCOMING_: false _R_CHECK_CRAN_INCOMING_REMOTE_: false shell: bash run: | - echo "inputs.slim = ${{ inputs.slim }}" - if ${{ inputs.slim }} ; then - R CMD check --no-manual --no-build-vignettes --no-vignettes --ignore-vignettes *.tar.gz - else R CMD check --no-manual --as-cran *.tar.gz - fi - name: Catch warnings in R CMD check output id: catch-errors diff --git a/.github/workflows/on_biweekly.yaml b/.github/workflows/on_biweekly.yaml index 793163a29..22d7de259 100644 --- a/.github/workflows/on_biweekly.yaml +++ b/.github/workflows/on_biweekly.yaml @@ -32,6 +32,4 @@ jobs: - name: Check uses: ./.github/actions/rcmdcheck - with: - slim: true diff --git a/.github/workflows/on_pr_main.yaml b/.github/workflows/on_pr_main.yaml index b15186ee3..a2bde37f3 100644 --- a/.github/workflows/on_pr_main.yaml +++ b/.github/workflows/on_pr_main.yaml @@ -32,8 +32,6 @@ jobs: - name: Check uses: ./.github/actions/rcmdcheck - with: - slim: true vignettes: @@ -53,5 +51,7 @@ jobs: uses: ./.github/actions/build-src - name: Build Vignettes + env: + RBMI_CACHE_DIR: local run: | Rscript ./vignettes/build.R diff --git a/.github/workflows/on_push.yaml b/.github/workflows/on_push.yaml index 0f73e518a..f2d9dd8e8 100644 --- a/.github/workflows/on_push.yaml +++ b/.github/workflows/on_push.yaml @@ -22,6 +22,8 @@ jobs: uses: ./.github/actions/build-src - name: testthat + env: + RBMI_CACHE_DIR: local run: | options(crayon.enabled = TRUE, cli.dynamic = FALSE) devtools::test(stop_on_failure = TRUE, reporter = testthat::CheckReporter) diff --git a/.gitignore b/.gitignore index 24d981c52..0f48158a6 100644 --- a/.gitignore +++ b/.gitignore @@ -61,3 +61,4 @@ docs local/ +*.rds diff --git a/.lintr b/.lintr index 4c353cbfe..42708d85c 100644 --- a/.lintr +++ b/.lintr @@ -1,4 +1,5 @@ -linters: with_defaults( +linters: linters_with_defaults( line_length_linter(120), - object_name_linter = NULL + object_name_linter = NULL, + indentation_linter(indent = 4L) ) diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 919aa9831..880a639bf 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -18,10 +18,25 @@ } }, { - "label": "R - testthat (FULL)", + "label": "rbmi - testthat (local cache)", + "problemMatcher": "$testthat", "command": "Rscript", + "args" : [ + "-e", + "devtools::test()" + ], "options": { "env": { + "RBMI_CACHE_DIR" : "${workspaceFolder}/local" + } + }, + }, + { + "label": "rbmi - testthat (FULL)", + "command": "Rscript", + "options": { + "env": { + "RBMI_CACHE_DIR" : "${workspaceFolder}/local", "R_TEST_FULL" : "TRUE" } }, @@ -34,27 +49,7 @@ "clear": true, "panel": "dedicated" }, - "problemMatcher": { - "owner": "R-testthat", - "severity": "error", - "fileLocation": [ - "relative", - "${workspaceFolder}/tests/testthat" - ], - "pattern": [ - { - "regexp": "^(Failure|Error)\\s\\((.*\\.[Rr]):(\\d+):(\\d+)\\):\\s(.*)", - "file": 2, - "line": 3, - "column": 4, - "message": 5 - }, - { - "regexp": "^(.*)$", - "message": 1 - } - ] - } + "problemMatcher": "$testthat" } ] } \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index eddf145f2..3d03277b7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,28 +33,17 @@ Suggests: lubridate, purrr, ggplot2, + rstan (>= 2.26.0), R.rsp -Biarch: true Config/testthat/edition: 3 Imports: mmrm, pkgload, Matrix, + tools, methods, - Rcpp (>= 0.12.0), - RcppParallel (>= 5.0.1), - rstan (>= 2.26.0), - rstantools (>= 2.1.1), R6, assertthat -LinkingTo: - BH (>= 1.66.0), - Rcpp (>= 0.12.0), - RcppEigen (>= 0.3.3.3.0), - RcppParallel (>= 5.0.1), - rstan (>= 2.26.0), - StanHeaders (>= 2.26.0) -SystemRequirements: GNU make Depends: R (>= 3.4.0) License: Apache License (>= 2) diff --git a/NAMESPACE b/NAMESPACE index 3b477fab8..8836268cf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -75,13 +75,9 @@ export(strategy_MAR) export(validate) export(validate_analyse_pars) import(R6) -import(Rcpp) import(methods) importFrom(assertthat,assert_that) importFrom(mmrm,VarCorr) -importFrom(rstan,extract) -importFrom(rstan,sampling) -importFrom(rstan,summary) importFrom(stats,aggregate) importFrom(stats,as.formula) importFrom(stats,binomial) @@ -107,4 +103,3 @@ importFrom(stats,var) importFrom(stats,vcov) importFrom(utils,capture.output) importFrom(utils,relist) -useDynLib(rbmi, .registration = TRUE) diff --git a/R/mcmc.R b/R/mcmc.R index d84d35477..e10da896a 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -4,7 +4,7 @@ #' @description #' `fit_mcmc()` fits the base imputation model using a Bayesian approach. #' This is done through a MCMC method that is implemented in `stan` -#' and is run by using the function [rstan::sampling()]. +#' and is run by using the function `rstan::sampling()`. #' The function returns the draws from the posterior distribution of the model parameters #' and the `stanfit` object. Additionally it performs multiple diagnostics checks of the chain #' and returns warnings in case of any detected issues. @@ -45,10 +45,7 @@ #' - `fit`: a `stanfit` object. #' #' -#' @import Rcpp #' @import methods -#' @importFrom rstan sampling -#' @useDynLib rbmi, .registration = TRUE fit_mcmc <- function( designmat, outcome, @@ -95,7 +92,7 @@ fit_mcmc <- function( ) sampling_args <- list( - object = stanmodels$MMRM, + object = get_stan_model(), data = stan_data, pars = c("beta", "Sigma"), chains = 1, @@ -116,7 +113,7 @@ fit_mcmc <- function( sampling_args$seed <- sample.int(.Machine$integer.max, 1) stan_fit <- record({ - do.call(sampling, sampling_args) + do.call(rstan::sampling, sampling_args) }) if (!is.null(stan_fit$errors)) { @@ -218,8 +215,8 @@ split_dim <- function(a, n) { #' @description #' Extract draws from a `stanfit` object and convert them into lists. #' -#' The function [rstan::extract()] returns the draws for a given parameter as an array. This function -#' calls [rstan::extract()] to extract the draws from a `stanfit` object +#' The function `rstan::extract()` returns the draws for a given parameter as an array. This function +#' calls `rstan::extract()` to extract the draws from a `stanfit` object #' and then convert the arrays into lists. #' #' @param stan_fit A `stanfit` object. @@ -233,10 +230,9 @@ split_dim <- function(a, n) { #' of the list is a list with length equal to 1 if `same_cov = TRUE` or equal to the #' number of groups if `same_cov = FALSE`. #' -#' @importFrom rstan extract extract_draws <- function(stan_fit) { - pars <- extract(stan_fit, pars = c("beta", "Sigma")) + pars <- rstan::extract(stan_fit, pars = c("beta", "Sigma")) names(pars) <- c("beta", "sigma") ##################### from array to list @@ -261,7 +257,6 @@ extract_draws <- function(stan_fit) { #' @return #' A named vector containing the ESS for each parameter of the model. #' -#' @importFrom rstan summary get_ESS <- function(stan_fit) { return(rstan::summary(stan_fit, pars = c("beta", "Sigma"))$summary[, "n_eff"]) } @@ -316,7 +311,7 @@ check_ESS <- function(stan_fit, n_draws, threshold_lowESS = 0.4) { #' 2. The Bayesian Fraction of Missing Information (BFMI) is sufficiently low. #' 3. The number of iterations that saturated the max treedepth is zero. #' -#' Please see [rstan::check_hmc_diagnostics()] for details. +#' Please see `rstan::check_hmc_diagnostics()` for details. #' #' @param stan_fit A `stanfit` object. #' diff --git a/R/stanmodels.R b/R/stanmodels.R deleted file mode 100644 index ee23926c5..000000000 --- a/R/stanmodels.R +++ /dev/null @@ -1,25 +0,0 @@ -# Generated by rstantools. Do not edit by hand. - -# names of stan models -stanmodels <- c("MMRM") - -# load each stan module -Rcpp::loadModule("stan_fit4MMRM_mod", what = TRUE) - -# instantiate each stanmodel object -stanmodels <- sapply(stanmodels, function(model_name) { - # create C++ code for stan model - stan_file <- if(dir.exists("stan")) "stan" else file.path("inst", "stan") - stan_file <- file.path(stan_file, paste0(model_name, ".stan")) - stanfit <- rstan::stanc_builder(stan_file, - allow_undefined = TRUE, - obfuscate_model_name = FALSE) - stanfit$model_cpp <- list(model_cppname = stanfit$model_name, - model_cppcode = stanfit$cppcode) - # create stanmodel object - methods::new(Class = "stanmodel", - model_name = stanfit$model_name, - model_code = stanfit$model_code, - model_cpp = stanfit$model_cpp, - mk_cppmodule = function(x) get(paste0("rstantools_model_", model_name))) -}) diff --git a/R/utilities.R b/R/utilities.R index b06e2ed79..00040d544 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -515,18 +515,92 @@ as_dataframe <- function(x) { -#' Do not run this function -#' -#' This function only exists to suppress the false positive -#' from R CMD Check about unused libraries -#' -#' Both rstantools and RcppParallel are required but are only used at -#' installation time. In the case of RcppParallel it is used in the -#' `src/Makevars` file which is created on the fly during installation -#' by rstantools. rstantools is used in the `configure` file. -#' -do_not_run <- function() { - rstantools::use_rstan() - RcppParallel::CxxFlags() +#' Ensure `rstan` exists +#' +#' Checks to see if rstan exists and if not throws a helpful error message +#' @keywords internal +ensure_rstan <- function() { + if (!requireNamespace("rstan", quietly = TRUE)) { + stop( + "In order to use `method_bayes()` the `rstan` package must be installed.", + " This can be installed from CRAN by running:\n\n", + " install.packages('rstan')\n\n", + "Please note that for `rstan` to work you need to ensure you have a valid C++ toolchain;", + " for details please see:\n", + "https://github.com/stan-dev/rstan/wiki/RStan-Getting-Started#configuring-c-toolchain\n\n" + ) + } +} + +#' Get Compiled Stan Object +#' +#' Gets a compiled Stan object that can be used with `rstan::sampling()` +#' @keywords internal +get_stan_model <- function() { + ensure_rstan() + local_file <- file.path("inst", "stan", "MMRM.stan") + system_file <- system.file(file.path("stan", "MMRM.stan"), package = "rbmi") + file_loc <- if (file.exists(local_file)) { + local_file + } else if (file.exists(system_file)) { + system_file + } else { + stop("Unable to find MMRM.stan; Please report this as a bug") + } + cache_dir = getOption("rbmi.cache_dir") + dir.create(cache_dir, showWarnings = FALSE, recursive = TRUE) + file_loc_cache <- file.path(cache_dir, "MMRM.stan") + if (!file.exists(file_loc_cache)) { + message("Compiling Stan model please wait...") + } + file.copy(file_loc, file_loc_cache, overwrite = TRUE) + rstan::stan_model( + file = file_loc_cache, + auto_write = TRUE, + model_name = "rbmi_mmrm" + ) } + + +#' rbmi settings +#' +#' @description +#' Define settings that modify the behaviour of the `rbmi` package +#' +#' Each of the following are the name of options that can be set via: +#' ``` +#' options( = ) +#' ``` +#' +#' ## `rbmi.cache_dir` +#' +#' Default = `tools::R_user_dir("rbmi", which = "cache")` +#' +#' Directory to store compiled Stan model in. If not set, a temporary directory is used for +#' the given R session. Can also be set via the environment variable `RBMI_CACHE_DIR`. +#' +#' +#' @examples +#' \dontrun{ +#' options(rbmi.cache_dir = "some/directory/path") +#' } +#' @name rbmi-settings +set_options <- function() { + + cache_dir <- Sys.getenv("RBMI_CACHE_DIR") + + if (cache_dir == "" || is.null(cache_dir)) { + cache_dir <- tools::R_user_dir("rbmi", which = "cache") + } + + current_opts <- names(options()) + rbmi_opts <- list( + rbmi.cache_dir = cache_dir + ) + for (opt in names(rbmi_opts)) { + if (!opt %in% current_opts) { + options(rbmi_opts[opt]) + } + } +} diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 000000000..e47af9ef3 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,6 @@ + + +.onLoad <- function(...) { + set_options() +} + diff --git a/configure b/configure deleted file mode 100755 index 1c0479869..000000000 --- a/configure +++ /dev/null @@ -1,4 +0,0 @@ -# Generated by rstantools. Do not edit by hand. - -#! /bin/sh -"${R_HOME}/bin/Rscript" -e "rstantools::rstan_config()" diff --git a/configure.win b/configure.win deleted file mode 100755 index 94d77bdc6..000000000 --- a/configure.win +++ /dev/null @@ -1,4 +0,0 @@ -# Generated by rstantools. Do not edit by hand. - -#! /bin/sh -"${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "rstantools::rstan_config()" diff --git a/inst/include/stan_meta_header.hpp b/inst/include/stan_meta_header.hpp deleted file mode 100644 index 3b914da24..000000000 --- a/inst/include/stan_meta_header.hpp +++ /dev/null @@ -1 +0,0 @@ -// Insert all #include statements here diff --git a/inst/stan/include/license.stan b/inst/stan/include/license.stan deleted file mode 100644 index 051725707..000000000 --- a/inst/stan/include/license.stan +++ /dev/null @@ -1,14 +0,0 @@ -/* - rbmi is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - rbmi is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with rbmi. If not, see . -*/ diff --git a/man/check_hmc_diagn.Rd b/man/check_hmc_diagn.Rd index db675be0b..793513f02 100644 --- a/man/check_hmc_diagn.Rd +++ b/man/check_hmc_diagn.Rd @@ -20,5 +20,5 @@ Check that: \item The number of iterations that saturated the max treedepth is zero. } -Please see \code{\link[rstan:check_hmc_diagnostics]{rstan::check_hmc_diagnostics()}} for details. +Please see \code{rstan::check_hmc_diagnostics()} for details. } diff --git a/man/do_not_run.Rd b/man/do_not_run.Rd deleted file mode 100644 index ede958cf9..000000000 --- a/man/do_not_run.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{do_not_run} -\alias{do_not_run} -\title{Do not run this function} -\usage{ -do_not_run() -} -\description{ -This function only exists to suppress the false positive -from R CMD Check about unused libraries -} -\details{ -Both rstantools and RcppParallel are required but are only used at -installation time. In the case of RcppParallel it is used in the -\code{src/Makevars} file which is created on the fly during installation -by rstantools. rstantools is used in the \code{configure} file. -} diff --git a/man/ensure_rstan.Rd b/man/ensure_rstan.Rd new file mode 100644 index 000000000..8c9f9eacf --- /dev/null +++ b/man/ensure_rstan.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{ensure_rstan} +\alias{ensure_rstan} +\title{Ensure \code{rstan} exists} +\usage{ +ensure_rstan() +} +\description{ +Checks to see if rstan exists and if not throws a helpful error message +} +\keyword{internal} diff --git a/man/extract_draws.Rd b/man/extract_draws.Rd index 6c866bdc3..dfcf88d99 100644 --- a/man/extract_draws.Rd +++ b/man/extract_draws.Rd @@ -23,7 +23,7 @@ number of groups if \code{same_cov = FALSE}. \description{ Extract draws from a \code{stanfit} object and convert them into lists. -The function \code{\link[rstan:stanfit-method-extract]{rstan::extract()}} returns the draws for a given parameter as an array. This function -calls \code{\link[rstan:stanfit-method-extract]{rstan::extract()}} to extract the draws from a \code{stanfit} object +The function \code{rstan::extract()} returns the draws for a given parameter as an array. This function +calls \code{rstan::extract()} to extract the draws from a \code{stanfit} object and then convert the arrays into lists. } diff --git a/man/fit_mcmc.Rd b/man/fit_mcmc.Rd index ccfbc1342..c116186f9 100644 --- a/man/fit_mcmc.Rd +++ b/man/fit_mcmc.Rd @@ -31,7 +31,7 @@ A named list composed by the following: \description{ \code{fit_mcmc()} fits the base imputation model using a Bayesian approach. This is done through a MCMC method that is implemented in \code{stan} -and is run by using the function \code{\link[rstan:stanmodel-method-sampling]{rstan::sampling()}}. +and is run by using the function \code{rstan::sampling()}. The function returns the draws from the posterior distribution of the model parameters and the \code{stanfit} object. Additionally it performs multiple diagnostics checks of the chain and returns warnings in case of any detected issues. diff --git a/man/get_stan_model.Rd b/man/get_stan_model.Rd new file mode 100644 index 000000000..c9f07d720 --- /dev/null +++ b/man/get_stan_model.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{get_stan_model} +\alias{get_stan_model} +\title{Get Compiled Stan Object} +\usage{ +get_stan_model() +} +\description{ +Gets a compiled Stan object that can be used with \code{rstan::sampling()} +} +\keyword{internal} diff --git a/man/rbmi-settings.Rd b/man/rbmi-settings.Rd new file mode 100644 index 000000000..de28d650f --- /dev/null +++ b/man/rbmi-settings.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{rbmi-settings} +\alias{rbmi-settings} +\alias{set_options} +\title{rbmi settings} +\usage{ +set_options() +} +\description{ +Define settings that modify the behaviour of the \code{rbmi} package + +Each of the following are the name of options that can be set via: + +\if{html}{\out{
}}\preformatted{options( = ) +}\if{html}{\out{
}} +\subsection{\code{rbmi.cache_dir}}{ + +Default = \code{tools::R_user_dir("rbmi", which = "cache")} + +Directory to store compiled Stan model in. If not set, a temporary directory is used for +the given R session. Can also be set via the environment variable \code{RBMI_CACHE_DIR}. +} +} +\examples{ +\dontrun{ +options(rbmi.cache_dir = "some/directory/path") +} +} diff --git a/src/.gitkeep b/src/.gitkeep deleted file mode 100644 index e69de29bb..000000000 diff --git a/tests/testthat/test-analyse.R b/tests/testthat/test-analyse.R index 900659bc6..7220b6803 100644 --- a/tests/testthat/test-analyse.R +++ b/tests/testthat/test-analyse.R @@ -4,8 +4,7 @@ suppressPackageStartupMessages({ }) -test_that("basic constructions of `analysis` work as expected",{ - +test_that("basic constructions of `analysis` work as expected", { oldopt <- getOption("warnPartialMatchDollar") options(warnPartialMatchDollar = TRUE)