Issue 187: making the examples executable

NAMESPACE

@@ -49,7 +49,6 @@ export(fill_locf)
 export(getStrategies)
 export(get_example_data)
 export(has_class)
-export(impute)
 export(locf)
 export(longDataConstructor)
 export(method_approxbayes)

R/analyse.R

@@ -92,32 +92,27 @@
 #' datasets prior to running `fun`. See details.
 #' @param ... Additional arguments passed onto `fun`.
 #' @examples
-#' \dontrun{
-#' vars <- set_vars(
-#'     subjid = "subjid",
-#'     visit = "visit",
-#'     outcome = "outcome",
-#'     group = "group",
-#'     covariates = c("sex", "age", "sex*age")
+#' imputeobj <- rbmi_example('imputeobj')
+#' delta_df <- rbmi_example('delta_df')
+#' vars = set_vars(
+#'     subjid = "PATIENT",
+#'     outcome = "CHANGE",
+#'     visit = "VISIT",
+#'     group = "THERAPY",
+#'     covariates = c("BASVAL")
 #' )
 #'
 #' analyse(
-#'     imputations = imputeObj,
+#'     imputeobj,
+#'     ancova,
 #'     vars = vars
 #' )
-#'
-#' deltadf <- data.frame(
-#'     subjid = c("Pt1", "Pt1", "Pt2"),
-#'     visit = c("Visit_1", "Visit_2", "Visit_2"),
-#'     delta = c( 5, 9, -10)
-#' )
-#'
 #' analyse(
-#'     imputations = imputeObj,
-#'     delta = deltadf,
+#'     imputeobj,
+#'     ancova,
+#'     delta = delta_df,
 #'     vars = vars
-#' )
-#' }
+#'     )
 #' @export
 analyse <- function(imputations, fun = ancova, delta = NULL, ...) {
 
@@ -199,10 +194,9 @@ analyse <- function(imputations, fun = ancova, delta = NULL, ...) {
 #' that will provide a map from the new subject IDs to the old subject IDs.
 #'
 #' @examples
-#' \dontrun{
-#' extract_imputed_dfs(imputeObj)
-#' extract_imputed_dfs(imputeObj, c(1:3))
-#' }
+#' imputeobj <- rbmi_example('imputeobj')
+#' extract_imputed_dfs(imputeobj)
+#' extract_imputed_dfs(imputeobj, c(1:3))
 #' @returns
 #' A list of data.frames equal in length to the `index` argument.
 #'

R/delta.R

@@ -127,10 +127,9 @@
 #' post-ICE visits will stay the same regardless of this option).
 #'
 #' @examples
-#' \dontrun{
-#' delta_template(imputeObj)
-#' delta_template(imputeObj, delta = c(5,6,7,8), dlag = c(1,2,3,4))
-#' }
+#' imputeobj <- rbmi_example('imputeobj')
+#' delta_template(imputeobj)
+#' delta_template(imputeobj, delta = c(5,6,7,8), dlag = c(1,2,3,4))
 #' @seealso [analyse()]
 #' @export
 delta_template <- function(

R/expand.R

@@ -7,9 +7,7 @@
 #' @param x a vector.
 #'
 #' @examples
-#' \dontrun{
 #' locf(c(NA, 1, 2, 3, NA, 4)) # Returns c(NA, 1, 2, 3, 3, 4)
-#' }
 #' @export
 locf <- function(x) {
     inds <- cumsum(!is.na(x))
@@ -69,7 +67,7 @@ locf <- function(x) {
 #'
 #' ```
 #' library(dplyr)
-#' 
+#'
 #' dat_expanded <- expand(
 #'     data = dat,
 #'     subject = c("pt1", "pt2", "pt3", "pt4"),
@@ -81,14 +79,14 @@ locf <- function(x) {
 #' ```
 #'
 #' @examples
-#' \dontrun{
+#' dat <- rbmi_example('simpledat')
 #' dat_expanded <- expand(
 #'     data = dat,
 #'     subject = c("pt1", "pt2", "pt3", "pt4"),
 #'     visit = c("vis1", "vis2", "vis3")
 #' )
 #'
-#' dat_filled <- fill_loc(
+#' dat_filled <- fill_locf(
 #'     data = dat_expanded,
 #'     vars = c("Sex", "Age"),
 #'     group = "subject",
@@ -105,7 +103,6 @@ locf <- function(x) {
 #'     group = "subject",
 #'     order = "visit"
 #' )
-#' }
 #' @export
 expand <- function(data, ...) {
     vars <- list(...)

R/impute.R

@@ -84,26 +84,23 @@
 #' 23(6):1352–1371, 2013. \[Section 4.2 and 4.3\]
 #'
 #' @examples
-#' \dontrun{
-#'
+#' drawobj <- rbmi_example('drawobj')
 #' impute(
 #'     draws = drawobj,
-#'     references = c("Trt" = "Placebo", "Placebo" = "Placebo")
+#'     references = c("DRUG" = "PLACEBO", "PLACEBO" = "PLACEBO")
 #' )
 #'
 #' new_strategy <- data.frame(
-#'   subjid = c("Pt1", "Pt2"),
-#'   strategy = c("MAR", "JR")
+#'     PATIENT = as.factor(c('1503', '1507')),
+#'     strategy = c("MAR", "JR")
 #' )
 #'
 #' impute(
 #'     draws = drawobj,
-#'     references = c("Trt" = "Placebo", "Placebo" = "Placebo"),
+#'     references = c("DRUG" = "PLACEBO", "PLACEBO" = "PLACEBO"),
 #'     update_strategy = new_strategy
 #' )
-#' }
 #'
-#' @export
 impute <- function(draws, references = NULL, update_strategy = NULL, strategies = getStrategies()) {
     UseMethod("impute")
 }

R/utilities.R

@@ -190,15 +190,13 @@ sample_mvnorm <- function(mu, sigma) {
 #' - **messages** - NULL or a character vector if messages were produced
 #'
 #' @examples
-#' \dontrun{
 #' record({
 #'   x <- 1
 #'   y <- 2
 #'   warning("something went wrong")
 #'   message("O nearly done")
 #'   x + y
 #' })
-#' }
 record <- function(expr) {
     env <- new.env()
     result <- withCallingHandlers(
@@ -315,9 +313,7 @@ str_contains <- function(x, subs) {
 #' Can be either a single logical value (in which case it is applied to
 #' all variables) or a vector which is the same length as `vars`
 #' @examples
-#' \dontrun{
 #' sort_by(iris, c("Sepal.Length", "Sepal.Width"), decreasing = c(TRUE, FALSE))
-#' }
 sort_by <- function(df, vars = NULL, decreasing = FALSE) {
     if (is.null(vars)) {
         return(df)
@@ -382,7 +378,6 @@ sort_by <- function(df, vars = NULL, decreasing = FALSE) {
 #' @seealso [ancova()]
 #'
 #' @examples
-#' \dontrun{
 #'
 #' # Using CDISC variable names as an example
 #' set_vars(
@@ -394,8 +389,6 @@ sort_by <- function(df, vars = NULL, decreasing = FALSE) {
 #'     strategy = "strat"
 #' )
 #'
-#' }
-#'
 #' @export
 set_vars <- function(
     subjid = "subjid",
@@ -513,7 +506,21 @@ as_dataframe <- function(x) {
     return(x2)
 }
 
+#' Get example files path
+#'
+#'@param path Character variable of example file name. Default NULL list all example files
+rbmi_example <- function(name = NULL, ext = 'rds') {
+    make_pattern <- function(s) paste0('\\.', s, '$')
+    extpat <- make_pattern(ext)
+    noext <- function(filename, ext = 'rds') gsub(extpat, '', filename)
 
-
-
-
+    if (is.null(name)) {
+        fullpaths <- dir(system.file("extdata", package = "rbmi"), pattern=extpat, full.names = TRUE, ignore.case = TRUE)
+        filenames <- noext(basename(fullpaths))
+        out <- lapply(fullpaths, readRDS)
+        names(out) <- filenames
+        out
+    } else {
+        readRDS(system.file("extdata", paste0(name, '.rds'), package = "rbmi", mustWork = TRUE))
+    }
+}

data-raw/create_example_objects.R

@@ -0,0 +1,84 @@
+########################
+#
+# Create objects that are used in example
+#
+#
+#
+
+library(dplyr)
+devtools::load_all()
+
+data("antidepressant_data")
+dat <- antidepressant_data
+
+# Use expand_locf to add rows corresponding to visits with missing outcomes to the dataset
+dat <- expand_locf(
+    dat,
+    PATIENT = levels(dat$PATIENT), # expand by PATIENT and VISIT
+    VISIT = levels(dat$VISIT),
+    vars = c("BASVAL", "THERAPY"), # fill with LOCF BASVAL and THERAPY
+    group = c("PATIENT"),
+    order = c("PATIENT", "VISIT")
+)
+
+# create data_ice and set the imputation strategy to JR for
+# each patient with at least one missing observation
+dat_ice <- dat %>%
+    arrange(PATIENT, VISIT) %>%
+    filter(is.na(CHANGE)) %>%
+    group_by(PATIENT) %>%
+    slice(1) %>%
+    ungroup() %>%
+    select(PATIENT, VISIT) %>%
+    mutate(strategy = "JR")
+
+# In this dataset, subject 3618 has an intermittent missing values which does not correspond
+# to a study drug discontinuation. We therefore remove this subject from `dat_ice`.
+# (In the later imputation step, it will automatically be imputed under the default MAR assumption.)
+dat_ice <- dat_ice[-which(dat_ice$PATIENT == 3618),]
+
+# Define the names of key variables in our dataset and
+# the covariates included in the imputation model using `set_vars()`
+# Note that the covariates argument can also include interaction terms
+vars <- set_vars(
+    outcome = "CHANGE",
+    visit = "VISIT",
+    subjid = "PATIENT",
+    group = "THERAPY",
+    covariates = c("BASVAL*VISIT", "THERAPY*VISIT")
+)
+
+# Define which imputation method to use (here: Bayesian multiple imputation with 150 imputed datsets)
+method <- method_bayes(
+    burn_in = 200,
+    burn_between = 5,
+    n_samples = 150
+)
+
+# Create samples for the imputation parameters by running the draws() function
+set.seed(987)
+drawobj <- draws(
+    data = dat,
+    data_ice = dat_ice,
+    vars = vars,
+    method = method,
+    quiet = TRUE
+)
+
+imputeobj <- impute(
+    drawobj,
+    references = c("DRUG" = "PLACEBO", "PLACEBO" = "PLACEBO")
+)
+
+delta_df <- delta_template(imputeobj) %>%
+    as_tibble() %>%
+    mutate(delta = if_else(THERAPY == "DRUG" & is_missing , 5, 0)) %>%
+    select(PATIENT, VISIT, delta)
+
+simpledat <- data.frame(subject =  c("pt1", "pt2", "pt3", "pt4"), visit = rep('a', 4), Sex =  c("M", "F", "F", "M"), "Age" = c(50,40,30,20))
+
+saveRDS(drawobj, 'inst/extdata/drawobj.rds')
+saveRDS(imputeobj, 'inst/extdata/imputeobj.rds')
+saveRDS(delta_df, 'inst/extdata/delta_df.rds')
+saveRDS(simpledat, 'inst/extdata/simpledat.rds')
+