Merge pull request #97 from istallworthy/feedback

imports and error checking
istallworthy · Sep 25, 2023 · 90cdebe · 90cdebe
2 parents 267e8b1 + e76d1ef
commit 90cdebe
Show file tree

Hide file tree

Showing 8 changed files with 229 additions and 68 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -24,7 +24,6 @@ LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.2
 Imports:
-    dplyr,
     WeightIt,
     marginaleffects,
     tidyr,

diff --git a/R/assessBalance.R b/R/assessBalance.R
@@ -124,6 +124,9 @@ assessBalance <- function(home_dir, data, exposure, exposure_time_pts, outcome,
     if (missing(home_dir)) {
       stop("Please supply a home directory.", call. = FALSE)
     }
+    else if(!is.character(home_dir)){
+      stop("Please provide a valid home directory path as a string if you wish to save output locally.", call. = FALSE)
+    }
     else if(!dir.exists(home_dir)) {
       stop("Please provide a valid home directory path if you wish to save output locally.", call. = FALSE)
     }
@@ -133,24 +136,45 @@ assessBalance <- function(home_dir, data, exposure, exposure_time_pts, outcome,
     stop("Please supply data as either a dataframe with no missing data or imputed data in the form of a mids object or path to folder with imputed csv datasets.",
          call. = FALSE)
   }
+  else if (!mice::is.mids(data) & !is.data.frame(data) & !inherits(data, "list")) {
+    stop("Please provide wide data as a 'mids' object, a data frame, or a list of imputed csv files in the 'data' field.", call. = FALSE)
+  }
+
+
   if (missing(exposure)){
     stop("Please supply a single exposure.", call. = FALSE)
   }
+  else if(!is.character(exposure) | length(exposure) != 1){
+    stop("Please supply a single exposure as a character.", call. = FALSE)
+  }
+
   if (missing(outcome)){
     stop("Please supply a single outcome.", call. = FALSE)
   }
+  else if(!is.character(outcome) | length(outcome) != 1){
+    stop("Please supply a single outcome as a character.", call. = FALSE)
+  }
+
   if (missing(exposure_time_pts)){
     stop("Please supply the exposure time points at which you wish to create weights.", call. = FALSE)
   }
-
-  if (missing(type)){
-    stop("Please supply a 'weighted', 'prebalance' type", call. = FALSE)
+  else if(!is.numeric(exposure_time_pts)){
+    stop("Please supply a list of exposure time points as integers.", call. = FALSE)
   }
+
   if (missing(formulas)){
     stop("Please supply a list of balancing formulas.", call. = FALSE)
   }
+  else if(!inherits(formulas, "list")){
+    stop("Please provide a list of formulas for each exposure time point", call. = FALSE)
+  }
+  else if(length(formulas) != length(exposure_time_pts)){
+    stop("Please provide a list of formulas for each exposure time point", call. = FALSE)
+  }
 
-
+  if (missing(type)){
+    stop("Please supply a 'weighted', 'prebalance' type", call. = FALSE)
+  }
   if (!inherits(type, "character") | length(type) != 1 ){
     stop("Please provide a single type as a character string from the following list: 'prebalance', 'weighted'", call. = FALSE)
   }
@@ -164,10 +188,6 @@ assessBalance <- function(home_dir, data, exposure, exposure_time_pts, outcome,
     stop("The 'weighted' mode of this function requires weights be supplied in the form of output from createWeights.", call. = FALSE)
   }
 
-  if (!mice::is.mids(data) & !is.data.frame(data) & !inherits(data, "list")) {
-    stop("Please provide either a 'mids' object, a data frame, or a list of imputed csv files in the 'data' field.", call. = FALSE)
-  }
-
   if (!is.null(weights) & ! inherits(weights, "list")){
     stop("Please supply a list of weights output from the createWeights function.", call. = FALSE)
   }
@@ -186,8 +206,18 @@ assessBalance <- function(home_dir, data, exposure, exposure_time_pts, outcome,
     stop("Please provide a list variable names as characters that are important confounders.", call. = FALSE)
   }
 
-  if(!inherits(formulas, "list")){
-    stop("Please provide a list of formulas for each exposure time point", call. = FALSE)
+  if(!is.logical(verbose)){
+    stop("Please set verbose to either TRUE or FALSE.", call. = FALSE)
+  }
+  else if(length(verbose) != 1){
+    stop("Please provide a single TRUE or FALSE value to verbose.", call. = FALSE)
+  }
+
+  if(!is.logical(save.out)){
+    stop("Please set save.out to either TRUE or FALSE.", call. = FALSE)
+  }
+  else if(length(save.out) != 1){
+    stop("Please provide a single TRUE or FALSE value to save.out.", call. = FALSE)
   }
 
 

diff --git a/R/calcBalStats.R b/R/calcBalStats.R
@@ -5,22 +5,6 @@
 #' approaches to assessing balance for time-varying exposures by weighting
 #' statistics based on sample distribution in exposure histories.
 #'
-#' @importFrom ggplot2 ggplot
-#' @importFrom ggplot2 theme
-#' @importFrom ggplot2 geom_text
-#' @importFrom ggplot2 geom_vline
-#' @importFrom ggplot2 geom_point
-#' @importFrom ggplot2 xlab
-#' @importFrom ggplot2 aes
-#' @importFrom ggplot2 xlim
-#' @importFrom ggplot2 ggtitle
-#' @importFrom ggplot2 scale_y_discrete
-#' @importFrom ggplot2 element_text
-#' @importFrom ggplot2 element_rect
-#' @importFrom ggplot2 element_blank
-#' @importFrom ggplot2 guide_axis
-#' @importFrom ggplot2 ggsave
-#' @importFrom stargazer stargazer
 #' @param home_dir (optional) path to home directory (required if save.out =
 #'   TRUE)
 #' @param data data in wide format as: a data frame, path to folder of imputed
@@ -111,7 +95,6 @@ calcBalStats <- function(home_dir = NA, data, formulas, exposure, exposure_time_
   if (weighted == 1){
     weights_method = weights$method
     w <- weights$weights #IPTW weights
-    # data <- data %>% dplyr::mutate(weights = as.numeric(w))
     data$weights <- as.numeric(w)
   }
   else{
@@ -319,14 +302,6 @@ calcBalStats <- function(home_dir = NA, data, formulas, exposure, exposure_time_
 
             bal_stats <- as.data.frame(cbind(bal_stats, weighted_bal_stats))
 
-            # standardizing balance statistics after weighting by history
-            # bal_stats <- bal_stats %>%
-            #   dplyr::mutate(std_bal_stats = weighted_bal_stats /
-            #                   (sapply(seq(ncol(data[, covars])), function(x) { #issue: looking in data for unweighted vals but factors have additional vars
-            #                     sd(as.numeric(data[, covars][, x]), na.rm = TRUE) }) *# unweighted covar sd
-            #                      sd(data[, paste0(exposure, ".", exposure_time_pt)], na.rm = TRUE)))  # exposure SD at that time pt
-
-
             # bal_stats <- bal_stats %>%
             bal_stats$std_bal_stats <- weighted_bal_stats /
               (sapply(seq(nrow(bal_stats)), function(x) { #issue: looking in data for unweighted vals but factors have additional vars
@@ -501,10 +476,6 @@ calcBalStats <- function(home_dir = NA, data, formulas, exposure, exposure_time_
     bal_stats <- as.data.frame(bal_stats)
     bal_stats$covariate <- rownames(bal_stats)
 
-    # # Renames factor covariates
-    # bal_stats$covariate[sapply(strsplit(bal_stats$covariate, "_"), "[", 1) %in% factor_covariates] <-
-    #   sapply(strsplit(bal_stats$covariate, "_"), "[", 1)[sapply(strsplit(bal_stats$covariate, "_"), "[", 1) %in% factor_covariates]
-
     #averages across factor levels to create one bal stat per factor variable?
     data$ID <- as.numeric(data$ID)
     f_vars <- colnames(data)[sapply(data, is.factor)]

diff --git a/R/compareHistories.R b/R/compareHistories.R
@@ -106,6 +106,9 @@ compareHistories <- function(home_dir, exposure, exposure_time_pts, outcome, mod
     if (missing(home_dir)) {
       stop("Please supply a home directory.", call. = FALSE)
     }
+    else if(!is.character(home_dir)){
+      stop("Please provide a valid home directory path as a string if you wish to save output locally.", call. = FALSE)
+    }
     else if(!dir.exists(home_dir)) {
       stop("Please provide a valid home directory path if you wish to save output locally.", call. = FALSE)
     }
@@ -114,20 +117,46 @@ compareHistories <- function(home_dir, exposure, exposure_time_pts, outcome, mod
   if (missing(exposure)){
     stop("Please supply a single exposure.", call. = FALSE)
   }
+  else if(!is.character(exposure) | length(exposure) != 1){
+    stop("Please supply a single exposure as a character.", call. = FALSE)
+  }
+
   if (missing(outcome)){
     stop("Please supply a single outcome.", call. = FALSE)
   }
+  else if(!is.character(outcome) | length(outcome) != 1){
+    stop("Please supply a single outcome as a character.", call. = FALSE)
+  }
+
   if (missing(exposure_time_pts)){
     stop("Please supply the exposure time points at which you wish to create weights.", call. = FALSE)
   }
+  else if(!is.numeric(exposure_time_pts)){
+    stop("Please supply a list of exposure time points as integers.", call. = FALSE)
+  }
 
   if (missing(model)){
     stop("Please supply a list of model output", call. = FALSE)
   }
-  if(!inherits(model, "list")){
+  else if(!inherits(model, "list")){
     stop("Please provide a list of model output from the fitModel function.", call. = FALSE)
   }
 
+  if(!is.logical(verbose)){
+    stop("Please set verbose to either TRUE or FALSE.", call. = FALSE)
+  }
+  else if(length(verbose) != 1){
+    stop("Please provide a single TRUE or FALSE value to verbose.", call. = FALSE)
+  }
+
+  if(!is.logical(save.out)){
+    stop("Please set save.out to either TRUE or FALSE.", call. = FALSE)
+  }
+  else if(length(save.out) != 1){
+    stop("Please provide a single TRUE or FALSE value to save.out.", call. = FALSE)
+  }
+
+
 
   if(save.out){
     histories_dir <- file.path(home_dir, "histories")

diff --git a/R/createFormulas.R b/R/createFormulas.R
@@ -95,6 +95,9 @@ createFormulas <- function(home_dir, exposure, exposure_time_pts, outcome, type,
     if (missing(home_dir)) {
       stop("Please supply a home directory.", call. = FALSE)
     }
+    else if(!is.character(home_dir)){
+      stop("Please provide a valid home directory path as a string if you wish to save output locally.", call. = FALSE)
+    }
     else if(!dir.exists(home_dir)) {
       stop("Please provide a valid home directory path if you wish to save output locally.", call. = FALSE)
     }
@@ -103,20 +106,37 @@ createFormulas <- function(home_dir, exposure, exposure_time_pts, outcome, type,
   if (missing(exposure)){
     stop("Please supply a single exposure.", call. = FALSE)
   }
+  else if(!is.character(exposure) | length(exposure) != 1){
+    stop("Please supply a single exposure as a character.", call. = FALSE)
+  }
+
   if (missing(outcome)){
     stop("Please supply a single outcome.", call. = FALSE)
   }
+  else if(!is.character(outcome) | length(outcome) != 1){
+    stop("Please supply a single outcome as a character.", call. = FALSE)
+  }
+
   if (missing(exposure_time_pts)){
     stop("Please supply the exposure time points at which you wish to create weights.", call. = FALSE)
   }
+  else if(!is.numeric(exposure_time_pts)){
+    stop("Please supply a list of exposure time points as integers.", call. = FALSE)
+  }
+
   if (missing(tv_confounders)){
     warning("You have not specified any time-varying confounders. If you have time-varying exposure, please list all wide exposure variables as tv_confounders.", call. = FALSE)
     tv_confounders <- character(0)
   }
+  else if(!is.character(tv_confounders)){
+    stop("Please provide a list of time-varying confounders as character strings.")
+  }
+
   if (missing(ti_confounders)){
     stop("You have not specified time invariant confounders.", call. = FALSE)
     # ti_confounders <- NULL
   }
+
   if (missing(type)){
     stop("Please supply a 'full', 'short', or 'update' type", call. = FALSE)
   }
@@ -135,6 +155,20 @@ createFormulas <- function(home_dir, exposure, exposure_time_pts, outcome, type,
     stop("Please provide a data frame of balance statistics from the assessBalance function.", call. = FALSE)
   }
 
+  if(!is.logical(verbose)){
+    stop("Please set verbose to either TRUE or FALSE.", call. = FALSE)
+  }
+  else if(length(verbose) != 1){
+    stop("Please provide a single TRUE or FALSE value to verbose.", call. = FALSE)
+  }
+
+  if(!is.logical(save.out)){
+    stop("Please set save.out to either TRUE or FALSE.", call. = FALSE)
+  }
+  else if(length(save.out) != 1){
+    stop("Please provide a single TRUE or FALSE value to save.out.", call. = FALSE)
+  }
+
 
   time_varying_covariates <- tv_confounders
   all_covars <- c(tv_confounders, ti_confounders)
@@ -192,7 +226,11 @@ createFormulas <- function(home_dir, exposure, exposure_time_pts, outcome, type,
 
       else if (type == "update"){
         if(is.null(bal_stats)){
-          stop("Please provide balance statistics if you wish to run the update version of this function", call. = FALSE)
+          stop("Please provide balance statistics from the assessBalance() function if you wish to run the update version of this function", call. = FALSE)
+        }
+        else if (!is.data.frame(bal_stats)){
+          stop("Please provide balance statistics from the assessBalance() function if you wish to run the update version of this function", call. = FALSE)
+
         }
 
         if(verbose){