Merge pull request #49 from istallworthy/testing

teting & updates

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export(assessBalance)
 export(calcBalStats)
 export(createWeights)
 export(fitModel)
@@ -9,6 +8,7 @@ export(imputeData)
 importFrom(WeightIt,weightitMSM)
 importFrom(cobalt,bal.tab)
 importFrom(doRNG,"%dorng%")
+importFrom(dplyr,"%>%")
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)

R/compareHelpers.R

@@ -1,4 +1,4 @@
-# FUNCTIONS
+# FUNCTIONS called by compareHistories
 
 #custom contrasts
 get_reference_values <- function(d, reference) {
@@ -15,12 +15,12 @@ get_comparison_values <- function(d, comp_histories) {
       d[x, unlist(strsplit(comp, "-"))[x]]
     })
   })
-  return(t(comp_vals))
+  t(comp_vals)
 }
 
 
 create_custom_contrasts <- function(d, reference, comp_histories, exposure, preds) {
-  if (is.na(reference) | any(is.na(comp_histories))) {
+  if (is.na(reference) | is.null(comp_histories)) {
     return(NULL)  # Invalid input, return early
   }
 
@@ -32,7 +32,7 @@ create_custom_contrasts <- function(d, reference, comp_histories, exposure, pred
     y |> marginaleffects::hypotheses(cus_comps)
   })
 
-  return(comps)
+  comps
 }
 
 
@@ -50,13 +50,15 @@ create_custom_comparisons <- function(preds, ref_vals, comp_vals, exposure) {
   }
 
   if (nrow(comp_vals) > 1) {
-    colnames(cus_comps) <- paste0("(", paste0(paste0(ref_vals, collapse = ","), ") - (", apply(comp_vals, 1, paste, collapse = ",")), ")")
+    colnames(cus_comps) <- paste0("(", paste0(paste0(ref_vals, collapse = ","), ") - (",
+                                              apply(comp_vals, 1, paste, collapse = ",")), ")")
   } else {
-    colnames(cus_comps) <- paste0("(", paste0(paste0(ref_vals, collapse = ","), ") - (", paste0(paste0(comp_vals, collapse = ",")), ")"))
+    colnames(cus_comps) <- paste0("(", paste0(paste0(ref_vals, collapse = ","), ") - (",
+                                              paste0(paste0(comp_vals, collapse = ",")), ")"))
   }
 
   cus_comps[is.na(cus_comps)] <- 0
-  return(cus_comps)
+  cus_comps
 }
 
 
@@ -75,73 +77,64 @@ add_histories <- function(p, d) {
     history <- unlist(history)
   }
 
-  if("term" %in% colnames(p)){
+  if("term" %in% colnames(p)) { #preds_pool
     history <- matrix(data = NA, nrow = nrow(p), ncol = 1) # Get histories from the first element
 
-    if(grepl("\\=", p$term[1])){
+    if(grepl("\\=", p$term[1])) {
       for (i in 1:nrow(p)){
         vals <- as.numeric(sapply(strsplit(unlist(strsplit(as.character(p$term[i]), "\\,")), "="), "[",2))
-        history[i] <- as.data.frame(paste(ifelse(round(vals,3)==round(d$l,3), "l", "h"), collapse="-"))
+        history[i] <- as.data.frame(paste(ifelse(round(vals, digits = 2) == round(d$l, digits = 2), "l", "h"), collapse = "-"))
       }
       history <- unlist(history)
 
-    }else{
+    } else {
       for (i in 1:nrow(p)) {
         temp <- as.character(p$term[i])
         pair <- lapply(1:2, function(y) {
           a <- sapply(strsplit(temp, " - "), "[", y)
           his <- lapply(1:nrow(d), function(z) {
-            ifelse(round(as.numeric(gsub("[^0-9.-]", "", sapply(strsplit(a, "\\,"), "[", z))), 3) == round(d[z, "l"], 3), "l", "h")
+            ifelse(round(as.numeric(gsub("[^0-9.-]", "",
+                                         sapply(strsplit(a, "\\,"), "[", z))), 2) == round(d[z, "l"], 2), "l", "h")
           })
         })
         history[i, 1] <- paste(sapply(pair, paste, collapse = "-"), collapse = " vs ")
       }
     }
-
   }
-
   p <- cbind (p, history = history)
-
   p
 }
 
 
-add_dose <- function(p, dose_level){
-  if( length(p$history[1]) == 1 ){
-    if(grepl("vs", p$history[1])){
+add_dose <- function(p, dose_level) {
+  if( length(p$history[1]) == 1 ) {
+    if(grepl("vs", p$history[1])) {
       dose_a <- stringr::str_count(sapply(strsplit(p$history, "vs"), "[", 1), dose_level)
       dose_b <- stringr::str_count(sapply(strsplit(p$history, "vs"), "[", 2), dose_level)
       dose_count <- data.frame(dose = gsub(" ", " vs ", paste(dose_a, dose_b)))
     } else{
-
       dose_count <- stringr::str_count(p$history, dose_level)
-
     }
   }
-
   if (length(p$history[1]) > 1){
     dose_count <- stringr::str_count(p$history, dose_level)
   }
-
-  # dose_count <- rep(list(dose_count), length(p))
   p <- cbind (p, dose_count = dose_count)
   p
 }
 
 
-perform_multiple_comparison_correction <- function(comps, method) {
+perform_multiple_comparison_correction <- function(comps, reference, comp_histories, method) {
   if (any(is.na(reference) & is.na(comp_histories)) | length(comp_histories) > 1) {
     cat("\n")
     cat(paste0("Conducting multiple comparison correction using the ", method, " method."), "\n")
     cat("\n")
-    corr_p <- lapply(comps, function(x) {
-      stats::p.adjust(x$p.value, method = method)
-    })
-    comps <- Map(cbind, comps, p.value_corr = corr_p)
+    corr_p <-stats::p.adjust(comps$p.value, method = method)
+    comps <- cbind(comps, p.value_corr = corr_p)
   } else {
-    cat(paste0("The user specified comparison only between ", reference, " and ", comp_histories,
-               " so no correction for multiple comparisons will be implemented."), "\n")
+    cat("\n")
+    cat(paste0("The user specified comparison only between ", reference, " and a single comparison, ", comp_histories,
+               ", so no correction for multiple comparisons will be implemented."), "\n")
   }
-
-  return(comps)
+  comps
 }