Skip to content

Commit

Permalink
Tweaks for cran (#278)
Browse files Browse the repository at this point in the history
  • Loading branch information
mattsecrest authored Apr 4, 2024
1 parent 4e6b0b1 commit d29a3ad
Show file tree
Hide file tree
Showing 75 changed files with 376 additions and 269 deletions.
3 changes: 2 additions & 1 deletion .github/workflows/R-CMD-check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ jobs:
matrix:
config:
- {os: macOS-latest, r: 'release'}
- {os: windows-latest, r: 'release'}
#- {os: windows-latest, r: 'release'}
- {os: ubuntu-latest, r: 'release'}
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
Expand All @@ -38,6 +38,7 @@ jobs:
with:
extra-packages: rcmdcheck, survival, flexsurv, testthat, usethis, vdiffr, tibble, xml2, knitr, rmarkdown, bayesplot, matrixcalc, WeightIt, MatchIt, BayesPPD, ggsurvfit, gbm, ggplot2, cobalt, table1, gt, gtsummary
dependencies: '"hard"'
cache: false

- name: Install system dependencies on Linux
if: runner.os == 'Linux'
Expand Down
8 changes: 5 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -27,17 +27,19 @@ Authors@R: c(
Description: Bayesian dynamic borrowing is an approach to incorporating external
data to supplement a randomized, controlled trial analysis in which
external data are incorporated in a dynamic way (e.g., based on similarity
of outcomes); see Viele 2013 \doi{10.1002/pst.1589} for an overview.
of outcomes); see Viele 2013 <doi:10.1002/pst.1589> for an overview.
This package implements the hierarchical commensurate prior approach to dynamic borrowing
as described in Hobbes 2011 \doi{10.1111/j.1541-0420.2011.01564.x}.
as described in Hobbes 2011 <doi:10.1111/j.1541-0420.2011.01564.x>.
There are three main functionalities. First, 'psborrow2' provides a user-friendly
interface for applying dynamic borrowing on the study results handles the Markov Chain
Monte Carlo sampling on behalf of the user. Second, 'psborrow2' provides a
simulation framework to compare different borrowing parameters (e.g. full borrowing, no
borrowing, dynamic borrowing) and other trial and borrowing characteristics
(e.g. sample size, covariates) in a unified way. Third, 'psborrow2' provides
a set of functions to generate data for simulation studies, and also allows
the user to specify their own data generation process.
the user to specify their own data generation process. This package is designed to
use the sampling functions from 'cmdstanr' which can be installed from
<https://mc-stan.org/r-packages/>.
URL: https://github.com/Genentech/psborrow2, https://genentech.github.io/psborrow2/index.html
BugReports: https://github.com/Genentech/psborrow2/issues
License: Apache License 2.0
Expand Down
6 changes: 1 addition & 5 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -18,21 +18,18 @@ export(check_cmdstanr)
export(check_data_matrix_has_columns)
export(cont_var)
export(covariance_matrix)
export(create_alpha_string)
export(create_analysis_obj)
export(create_baseline_object)
export(create_data_matrix)
export(create_data_simulation)
export(create_event_dist)
export(create_simulation_obj)
export(create_tau_string)
export(custom_enrollment)
export(cut_off_after_events)
export(cut_off_after_first)
export(cut_off_after_last)
export(cut_off_none)
export(enrollment_constant)
export(eval_constraints)
export(exp_surv_dist)
export(exponential_prior)
export(gamma_prior)
Expand Down Expand Up @@ -81,11 +78,10 @@ export(sim_outcome_list)
export(sim_samplesize)
export(sim_treatment_list)
export(treatment_details)
export(trim_cols)
export(trim_rows)
export(uniform_prior)
export(variable_dictionary)
export(weib_ph_surv_dist)
exportMethods(c)
exportMethods(generate)
exportMethods(mcmc_sample)
exportMethods(set_transformations)
Expand Down
11 changes: 9 additions & 2 deletions R/borrowing_details.R
Original file line number Diff line number Diff line change
@@ -1,11 +1,18 @@
#' Legacy function for specifying borrowing details
#'
#' Please use one of `hierarchical_commensurate_borrowing()`, `no_borrowing()`, or `full_borrowing()` instead.
#' Please use one of `borrowing_hierarchical_commensurate()`, `borrowing_none()`, or `borrowing_full()` instead.
#' @export
#'
#' @return
#' This function does not return a value. When called, it triggers an error
#' message indicating that `borrowing_details()` is deprecated and that
#' one of `borrowing_hierarchical_commensurate()`, `borrowing_none()`, or
#' `borrowing_full()` should be used instead.
#'
#' @param ... Deprecated arguments to `borrowing_details`.
borrowing_details <- function(...) {
.Defunct(
"hierarchical_commensurate_borrowing()",
"borrowing_hierarchical_commensurate()",
"psborrow2",
paste(
"`borrowing_details()` is deprecated. Use `borrowing_hierarchical_commensurate()` for dynamic borrowing,",
Expand Down
5 changes: 2 additions & 3 deletions R/check_data_matrix_has_columns.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' @return `stop()` if some columns are missing.
#' @export
#' @examples
#' anls <- psborrow2:::.analysis_obj(
#' anls <- create_analysis_obj(
#' data_matrix = example_matrix,
#' covariates = add_covariates(
#' covariates = c("cov1", "cov2"),
Expand All @@ -25,8 +25,7 @@
#' treatment = treatment_details(
#' "trt",
#' prior_normal(0, 1000)
#' ),
#' ready_to_sample = FALSE
#' )
#' )
#'
#' check_data_matrix_has_columns(anls)
Expand Down
58 changes: 35 additions & 23 deletions R/generics.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,14 +10,13 @@
#' @param y Not used.
#' @param add logical. Add density to existing plot.
#' @param ... Optional arguments for plotting.
#'
#' @return No return value, this function generates a plot in the current graphics device.
#' @export
#' @details
#' Plot ranges are selected by default to show 99% of the density for unbounded distributions.
#' The limits can be changed by specifying `xlim = c(lower, upper)`.
#'
#' Colors, line types, and other typical [par()] parameters can be used.
#'
if (!isGeneric("plot")) setGeneric("plot", function(x, y, ...) standardGeneric("plot"))


Expand All @@ -29,7 +28,7 @@ if (!isGeneric("plot")) setGeneric("plot", function(x, y, ...) standardGeneric("
#' @aliases get_vars
#'
#' @param object Object
#' @returns A `character` vector containing variable names
#' @return A `character` vector containing variable names
#' @export
#'
setGeneric("get_vars", function(object) standardGeneric("get_vars"))
Expand Down Expand Up @@ -57,6 +56,8 @@ setGeneric("mcmc_sample", function(x, ...) standardGeneric("mcmc_sample"))
#'
#' @rdname show_guide
#'
#' @return A `data.frame` showing all simulation scenarios.
#'
#' @export
#'
setGeneric("show_guide", function(object) standardGeneric("show_guide"))
Expand All @@ -68,6 +69,8 @@ setGeneric("show_guide", function(object) standardGeneric("show_guide"))
#' @param object `MCMCSimulationResults` object
#'
#' @rdname get_results
#'
#' @return data.frame with simulation results.
#'
#' @export
#'
Expand All @@ -80,6 +83,8 @@ setGeneric("get_results", function(object) standardGeneric("get_results"))
#' @param object `MCMCSimulationResults` object
#'
#' @rdname get_cmd_stan_models
#'
#' @return List of lists of `CmdStanModel` objects for each model.
#'
#' @export
#'
Expand All @@ -92,6 +97,8 @@ setGeneric("get_cmd_stan_models", function(object) standardGeneric("get_cmd_stan
#'
#' @rdname generate
#'
#' @return Object of class [`SimDataList`][SimDataList-class].
#'
#' @export
setGeneric("generate", function(x, ...) standardGeneric("generate"))

Expand All @@ -101,8 +108,6 @@ setGeneric("generate", function(x, ...) standardGeneric("generate"))
#' @param analysis_object analysis object
#'
#' @rdname trim_rows
#'
#' @export
setGeneric("trim_rows", function(borrowing_object, analysis_object) standardGeneric("trim_rows"))

#' Trim columns from Data Matrix Based on Borrowing object type
Expand All @@ -111,8 +116,6 @@ setGeneric("trim_rows", function(borrowing_object, analysis_object) standardGene
#' @param analysis_object analysis object
#'
#' @rdname trim_cols
#'
#' @export
setGeneric("trim_cols", function(borrowing_object, analysis_object) standardGeneric("trim_cols"))

#' Create alpha string
Expand All @@ -121,20 +124,15 @@ setGeneric("trim_cols", function(borrowing_object, analysis_object) standardGene
#' @param outcome_object outcome object
#'
#' @rdname create_alpha_string
#'
#' @export
setGeneric("create_alpha_string", function(borrowing_object, outcome_object) standardGeneric("create_alpha_string"))

#' Create tau string
#'
#' @param borrowing_object borrowing object
#'
#' @rdname create_tau_string
#'
#' @export
setGeneric("create_tau_string", function(borrowing_object) standardGeneric("create_tau_string"))


#' Create Stan Code for Model
#'
#' @param borrowing borrowing object
Expand All @@ -145,12 +143,26 @@ setGeneric("create_tau_string", function(borrowing_object) standardGeneric("crea
#' @return `glue` `character` containing the Stan code for the data block.
#' @export
#' @examples
#' anls_obj <- psborrow2:::.analysis_obj(
#' data_matrix = example_matrix,
#' outcome = outcome_surv_exponential("time", "cnsr", prior_normal(0, 100)),
#' borrowing = borrowing_full("ext"),
#' treatment = treatment_details("trt", prior_normal(0, 100))
#' )
#' anls_obj <- create_analysis_obj(
#' data_matrix = example_matrix,
#' outcome = outcome_surv_exponential(
#' "time",
#' "cnsr",
#' baseline_prior = prior_normal(0, 1000)
#' ),
#' borrowing = borrowing_hierarchical_commensurate(
#' "ext",
#' prior_exponential(.001)
#' ),
#' treatment = treatment_details(
#' "trt",
#' prior_normal(0, 1000)
#' ),
#' covariates = add_covariates(
#' covariates = c("cov1", "cov2"),
#' priors = prior_normal(0, 1000)
#' )
#' )
#' make_model_string_model(anls_obj@borrowing, anls_obj@outcome, anls_obj)
setGeneric("make_model_string_model", function(borrowing, outcome, analysis_obj) {
standardGeneric("make_model_string_model")
Expand All @@ -164,7 +176,7 @@ setGeneric("make_model_string_model", function(borrowing, outcome, analysis_obj)
#'
#' @param x object of type: [BaselineDataList-class]
#' @param ... Optional arguments for passed to [data.frame]
#' @returns A `data.frame`
#' @return A `data.frame`
NULL

#' @title Combine objects in `psborrow2`
Expand All @@ -173,7 +185,7 @@ NULL
#' @name c
#' @param x object of type: [SimDataList-class]
#' @param ... additional objects to combine
#' @returns A combined object
#' @return A combined object
NULL

#' Get Simulated Data from `SimDataList` object
Expand All @@ -183,7 +195,7 @@ NULL
#' @param object `SimDataList` object
#' @param index the index of the scenario (see guide with print(`SimDataList`))
#' @param dataset the dataset out of `n_datasets_per_param`
#' @returns Simulated data as a data frame if the index is specified, else as a list
#' @return Simulated data as a data frame if the index is specified, else as a list
#' @export
setGeneric("get_data", function(object, index = 1, dataset = 1) standardGeneric("get_data"))

Expand All @@ -192,12 +204,12 @@ setGeneric("get_data", function(object, index = 1, dataset = 1) standardGeneric(
#' @param object `BaselineObject` object
#' @param ... Additional arguments passed to methods
#' @param overwrite logical. Overwrite existing transformations?
#' @returns `BaselineObject` object with transformations
#' @return `BaselineObject` object with transformations
#' @export
setGeneric("set_transformations", function(object, ..., overwrite = FALSE) standardGeneric("set_transformations"))

#' Get method for Stan model
#' @param object `Analysis` object
#' @returns String containing the Stan model
#' @return String containing the Stan model
#' @export
setGeneric("get_stan_code", function(object) standardGeneric("get_stan_code"))
19 changes: 13 additions & 6 deletions R/helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,11 @@
#'
#' Plots the density values as a curve with the lower vertical limit set to 0.
#'
#' @export
#'
#' @return No return value, this function generates a plot in the current graphics device.
#'
#' @export
#'
#' @examples
#' x <- seq(-2, 2, len = 100)
#' y <- dnorm(x)
Expand Down Expand Up @@ -36,6 +39,8 @@ plot_pdf <- function(x, y, ...) {
#'
#' Plots the probability values as a barplot.
#'
#' @return No return value, this function generates a plot in the current graphics device.
#'
#' @export
#'
#' @examples
Expand Down Expand Up @@ -73,12 +78,12 @@ plot_pmf <- function(x, y, ..., col = "grey", add = FALSE) {
#' @param collapse_sep string. A character string to separate the original strings in the collapsed string.
#'
#' @return A character (of class `glue`).
#' @noRd
#' @examples
#' name <- "Tom"
#' psborrow2:::h_glue("hello, my name is {{name}}.")
#' name <- c("Tom", "Fred")
#' psborrow2:::h_glue("hello, my name is {{name}}.", collapse = TRUE)
#' @noRd
h_glue <- function(..., collapse = FALSE, collapse_sep = "\n") {
result <- glue::glue(..., .open = "{{", .close = "}}", .envir = parent.frame())
if (isTRUE(collapse)) {
Expand All @@ -94,7 +99,7 @@ h_glue <- function(..., collapse = FALSE, collapse_sep = "\n") {
#'
#' @return A `matrix` with columns "lower" and "upper" with rows for each `Prior`.
#' @examples
#' psborrow2:::get_covariate_constraints(
#' get_covariate_constraints(
#' add_covariates(
#' c("cov1", "cov2", "cov3"),
#' list(
Expand All @@ -104,7 +109,7 @@ h_glue <- function(..., collapse = FALSE, collapse_sep = "\n") {
#' )
#' )
#' )
#'
#' @noRd
get_covariate_constraints <- function(cov_obj) {
n_covs <- length(cov_obj@covariates)
if (is(cov_obj@priors, "Prior")) {
Expand All @@ -125,7 +130,8 @@ get_covariate_constraints <- function(cov_obj) {
#' A list with upper and lower bounds. Any unspecified bounds are set to `-Inf` or `Inf`.
#' @examples
#' np <- prior_normal(0, 100)
#' psborrow2:::parse_constraint(np)
#' parse_constraint(np)
#' @noRd
parse_constraint <- function(object) {
assert_class(object, "Prior")
s <- eval_constraints(object)
Expand Down Expand Up @@ -214,7 +220,8 @@ variable_dictionary <- function(analysis_obj) {
#'
#' @return A string containing the Stan code sampling from specified distribution.
#' @examples
#' psborrow2:::get_prior_string(prior_normal(0, 100))
#' get_prior_string(prior_normal(0, 100))
#' @noRd
get_prior_string <- function(object) {
assert_multi_class(object, c("Prior", "list"))
if (is(object, "list")) {
Expand Down
10 changes: 5 additions & 5 deletions R/make_model_string_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,20 +3,20 @@
#' Create the Stan string encompassed by data `{}`
#'
#' @param analysis_obj `Analysis`. Object of class [`Analysis`][Analysis-class] created by
#' `psborrow2:::.analysis_obj()`.
#' `.analysis_obj()`.
#'
#' @return `glue` `character` containing the text for the data block.
#'
#' @examples
#' anls_obj <- psborrow2:::.analysis_obj(
#' anls_obj <- .analysis_obj(
#' data_matrix = example_matrix,
#' outcome = outcome_surv_exponential("time", "cnsr", prior_normal(0, 100)),
#' borrowing = borrowing_full("ext"),
#' treatment = treatment_details("trt", prior_normal(0, 100))
#' )
#'
#' psborrow2:::make_model_string_data(anls_obj)
#'
#'
#' make_model_string_data(anls_obj)
#' @noRd
make_model_string_data <- function(analysis_obj) {
outcome_string <- analysis_obj@outcome@data_stan_code

Expand Down
Loading

0 comments on commit d29a3ad

Please sign in to comment.