Merge pull request #204 from kylebutts/main

2024-06-20 Meeting

R/assessBalance.R

@@ -283,6 +283,8 @@ print.devMSM_bal_stats <- function(x, i = NA, t = TRUE, save.out = FALSE, ...) {
     }
   }
 
+  return(invisible(t))
+
   # TODO: Print omitted histories?
   # if (verbose) {
   #   if (data_type == "imputed") {
@@ -357,8 +359,6 @@ summary.devMSM_bal_stats <- function(object, i = NA, t = TRUE, save.out = FALSE,
       }
     }
     message(msg)
-
-    return(invisible())
   }
 
   imbalanced_std_bal_stats <- unlist(lapply(
@@ -479,6 +479,7 @@ summary.devMSM_bal_stats <- function(object, i = NA, t = TRUE, save.out = FALSE,
     }
   }
 
+  return(invisible(t))
 }
 
 #' @rdname assessBalance

R/compareHistories.R

@@ -215,6 +215,8 @@ compareHistories <- function(
   # pooling predicted values and contrasts for imputed data
   is_pooled <- length(preds) > 1
   if (is_pooled) { # IMPUTED DATA
+    # TODO: Delete this code when `modelsummary` goes onto CRAN & require that version in DESCRIPTION 
+    # `modelsummary (>= 1.4.4),`
     # TODO: should be fixed by modelsummary: https://github.com/vincentarelbundock/modelsummary/commit/5f13fe03683016ae92e5ffdd4b8b6b402614409e
     # 
     # assign(
@@ -371,6 +373,8 @@ print.devMSM_comparisons <- function(x, save.out = FALSE, ...) {
       tinytable::save_tt(comps_tab, output = out, overwrite = TRUE)
     }
   }
+
+  return(invisible(comps_tab))
 }
 
 

R/devMSMs-package.R

@@ -19,11 +19,13 @@ NULL
 #' @param fit list of model outputs from [fitModel()]
 #' @param bal_stats list of balance statistics from [assessBalance()]
 #' 
-#' @param verbose (optional) TRUE or FALSE indicator for printing output to console
-#'  (default is FALSE)
+#' @param verbose (optional) TRUE or FALSE indicator for printing output to console.
+#' default is FALSE.
 #' @param save.out (optional) Either logical or a character string. If `TRUE`, 
 #' it will output the result to a default file name within `home_dir` set in `initMSM()`. You can load the data with `x <- readRDS(file)`. 
-#' To use a non-default file name, specify a character string with the file name. It will save relative to `home_dir`. (default is FALSE). 
+#' To use a non-default file name, specify a character string with the file name. It will save relative to `home_dir`. 
+#' There might be naming conflicts where two objects get saved to the same file. In these cases, users should specify a custom name.
+#' default is FALSE. 
 #' 
 #' @param i For multiply imputed datset, `i` selects which imputation to print results for.
 #'  Default is `i = 1`. With `i = TRUE`, all imputed datasets will be looped over. With `i = NULL`, will average over all imputed datasets and summarize that. 

R/fitModel.R

@@ -346,4 +346,6 @@ print.devMSM_models <- function(x, i = 1, save.out = FALSE, ...) {
       tinytable::save_tt(t, output = out, overwrite = TRUE)
     }
   }
+
+  return(invisible(t))
 }

R/trimWeights.R

@@ -56,7 +56,6 @@ trimWeights <- function(obj, weights, at = 0, lower = FALSE, verbose = FALSE, sa
   trim_weights <- lapply(weights, WeightIt::trim, at = at, lower = lower)
 
   class(trim_weights) <- c("devMSM_weights", "list")
-  # TODO: Do not need to pass `obj` since it's attached to `weights`
   attr(trim_weights, "obj") <- obj
   attr(trim_weights, "method") <- attr(weights, "method")
   attr(trim_weights, "form_type") <- attr(weights, "form_type")
@@ -75,7 +74,11 @@ trimWeights <- function(obj, weights, at = 0, lower = FALSE, verbose = FALSE, sa
     } else {
       file_name <- sprintf(
         "type_%s-exposure_%s-method_%s-trim_at_%s-lower_%s.rds",
-        attr(weights, "form_type"), attr(obj, "exposure_root"),  attr(weights, "method"), at, tolower(lower)
+        attr(weights, "form_type"), 
+        attr(obj, "exposure_root"),  
+        attr(weights, "method"), 
+        at, 
+        tolower(lower)
       )
     }
     out <- fs::path_join(c(out_dir, file_name))

R/utils.R

@@ -185,6 +185,7 @@ perm2 <- function(r, v) {
           out <- x[[z]]
           out
         }),
+        # TODO: Absolute value or not? 
         function(q) abs(q[["std_bal_stats"]]))
     }), 
     average_sub_lists)

dev.R

@@ -50,6 +50,8 @@ print(f)
 f <- createFormulas(obj = obj, type = "short", save.out = TRUE)
 print(f)
 
+# f <- readRDS("/Users/kylebutts/Desktop/Work/Jobs/devMSM/temp-out/formulas/type_short-exposure_A.rds")
+
 f <- createFormulas(obj = obj, type = "short", save.out = "test_custom_name.rds")
 
 # Weights ----
@@ -67,8 +69,11 @@ w <- createWeights(
 )
 plot(w, i = 1, save.out = TRUE)
 plot(w, i = 2, save.out = TRUE)
-p <- plot(w, i = TRUE, save.out = TRUE)
-plot(p[[1]])
+p <- plot(w, i = TRUE)
+p[[1]] + ggplot2::labs(title = "hi!") + ggplot2::theme_bw()
+
+
+# Document `save.out`
 
 # TODO: Should we document that you can use WeightIt internal functions? Can think of: 
 # - plots with `i = TRUE`, (p[[i]] extracts `ggplot2` object)
@@ -79,8 +84,8 @@ plot(p[[1]])
 # here's an example of WeightIt functions being called:
 summary(w[[1]])
 plot(summary(w[[1]]))
-plot(summary(w[[1]]), time = 1)
-
+plot(summary(w[[1]]), time = 2)
+summary(w)
 
 # Trim weights ----
 t <- trimWeights(obj = obj, weights = w, at = 0.975, lower = FALSE, save.out = TRUE)
@@ -104,12 +109,15 @@ plot(b, t = 3)
 plot(b, t = c(1, 2, 3))
 plot(b, t = c("A.1", "A.2"))
 
-# b/c of tinytable, can use `.tex`/`.html`/`.png`/`.pdf`
+t <- summary(b)
+
+# b/c of tinytable, can use `.tex`/`.html`/`.pdf`
 summary(b, save.out = "summ_b.html") 
 summary(b, save.out = "summ_b.tex") 
 print(b, save.out = "print_b.html") 
 print(b, save.out = "print_b.tex") 
 print(b, save.out = "print_b.pdf") 
+print(b, save.out = "print_b.txt")
 
 
 bw <- assessBalance(data = data, obj = obj, weights = w)