Update to readme

R/InterXshift.R

@@ -124,6 +124,7 @@ InterXshift <- function(w,
     colnames(w) <- w_names
   }
 
+
   # coerce W to matrix and, if no names in W, assign them generically
   a <- data.frame(a)
   a_names <- colnames(a)
@@ -311,9 +312,6 @@ InterXshift <- function(w,
 
       }
 
-
-
-
       for (i in 1:nrow(fold_negative_effects)) {
 
         exposure <- fold_negative_effects$Variable[i]
@@ -477,9 +475,9 @@ InterXshift <- function(w,
 
         syngery_in_fold <- calc_final_joint_shift_param(
           joint_shift_fold_results = intxn_results_list,
-          rank,
-          fold_k,
-          deltas_updated,
+          rank = rank,
+          fold_k = fold_k,
+          deltas_updated = deltas_updated,
           exposures = exposures
         )
 
@@ -574,10 +572,10 @@ InterXshift <- function(w,
 
         antagonism_in_fold <- calc_final_joint_shift_param(
           joint_shift_fold_results = intxn_results_list,
-          rank,
-          fold_k,
-          deltas_updated,
-          exposures
+          rank = rank,
+          fold_k = fold_k,
+          deltas_updated = deltas_updated,
+          exposures = exposures
         )
 
         antagonism_rank_fold_results[[
@@ -608,13 +606,13 @@ InterXshift <- function(w,
 
       results_list
     },
-    .options = furrr::furrr_options(seed = seed, packages = "SuperNOVA")
+    .options = furrr::furrr_options(seed = seed, packages = "InterXshift")
   )
 
-  top_positive_results <- purrr::map(fold_SuperNOVA_results, c("top_positive_effects"))
-  top_negative_results <- purrr::map(fold_SuperNOVA_results, c("top_negative_effects"))
-  top_synergy_results <- purrr::map(fold_SuperNOVA_results, c("top_synergy_effects"))
-  top_antagonism_results <- purrr::map(fold_SuperNOVA_results, c("top_antagonism_effects"))
+  top_positive_results <- purrr::map(fold_InterXshift_results, c("top_positive_effects"))
+  top_negative_results <- purrr::map(fold_InterXshift_results, c("top_negative_effects"))
+  top_synergy_results <- purrr::map(fold_InterXshift_results, c("top_synergy_effects"))
+  top_antagonism_results <- purrr::map(fold_InterXshift_results, c("top_antagonism_effects"))
 
   top_positive_results <- unlist(top_positive_results, recursive = FALSE)
   top_negative_results <- unlist(top_negative_results, recursive = FALSE)
@@ -636,7 +634,7 @@ InterXshift <- function(w,
     n_folds = n_folds
   )
 
-  pooled_intxn_shift_results <- calc_pooled_intxn_shifts(
+  pooled_synergy_shift_results <- calc_pooled_intxn_shifts(
     intxn_shift_results = top_synergy_results,
     estimator = estimator,
     a_names = a_names,
@@ -646,13 +644,24 @@ InterXshift <- function(w,
     n_folds = n_folds
   )
 
+  pooled_antagonism_shift_results <- calc_pooled_intxn_shifts(
+    intxn_shift_results = top_antagonism_results,
+    estimator = estimator,
+    a_names = a_names,
+    w_names = w_names,
+    z_names = z_names,
+    fluctuation = fluctuation,
+    n_folds = n_folds
+  )
+
 
   results_list <- list(
-    "Basis Fold Proportions" = basis_prop_in_fold,
-    "Effect Mod Results" = pooled_em_shift_results,
-    "Indiv Shift Results" = pooled_indiv_shift_results,
-    "Joint Shift Results" = pooled_intxn_shift_results,
-    "Mediation Shift Results" = pooled_med_shift_results
+    "Pos Shift Results" = pooled_pos_shift_results,
+    "Neg Shift Results" = pooled_neg_shift_results,
+    "K Fold Synergy Results" = pooled_synergy_shift_results$k_fold_results,
+    "Pooled Synergy Results" = pooled_synergy_shift_results$pooled_results,
+    "K Fold Antagonism Results" = pooled_antagonism_shift_results$k_fold_results,
+    "Pooled Antagonism Results" = pooled_antagonism_shift_results$pooled_results
   )
 
   return(results_list)

R/calc_pooled_intxn_shifts.R

@@ -119,23 +119,21 @@ calc_pooled_intxn_shifts <- function(intxn_shift_results,
       intxn_results_list[[i]] <- tmle_fit
     }
 
-    # var_names <- extract_vars_from_basis(
-    #   var_set, 1,
-    #   a_names, w_names, z_names
-    # )
-
     intxn_pooled <- calc_final_joint_shift_param(
       joint_shift_fold_results = intxn_results_list,
       rank = var_set,
       fold_k = "Pooled TMLE",
-      deltas_updated = deltas
+      deltas_updated = deltas,
+      exposures = c("Var 1","Var 2","Joint","Interaction")
     )
 
+    rownames(k_fold_results) <- NULL
+
 
     pooled_results_list[[var_set]] <- intxn_pooled
     k_fold_results_list[[var_set]] <- k_fold_results
   }
 
 
-  return(results_list)
+  return(list("k_fold_results" = k_fold_results_list, "pooled_results" = pooled_results_list))
 }

R/final_result_utils.R

@@ -81,7 +81,7 @@ calculatePooledEstimate <- function(results_df, n_folds, delta = NULL) {
 #' @export
 calc_final_ind_shift_param <- function(tmle_fit, exposure, fold_k) {
   condition <- exposure
-  psi_param <- tmle_fit$noshift_psi - tmle_fit$psi
+  psi_param <-  tmle_fit$psi - tmle_fit$noshift_psi
   variance_est <- var(tmle_fit$eif - tmle_fit$noshift_eif) /
     length(tmle_fit$eif)
   se_est <- sqrt(variance_est)
@@ -274,6 +274,7 @@ calc_final_effect_mod_param <- function(tmle_fit_av,
 #' @title Calculates the Joint Shift Parameter
 #' @description Estimates the shift parameter for a joint shift
 #' @param joint_shift_fold_results Results of the joint shift
+#' @param rank ranking of the interaction found
 #' @param exposures Exposures shifted
 #' @param fold_k Fold the joint shift is identified
 #' @param deltas_updated The new delta, could be updated if Hn has positivity

R/find_synergy_antagonism.R

@@ -68,17 +68,17 @@ find_synergy_antagonism <- function(data, deltas, a_names, w_names, outcome, out
     shifted_data <- as.data.frame(data)
     shifted_data[[var]] <- shifted_data[[var]] + deltas[[var]]
     predictions <- sl_fit$predict(sl3::make_sl3_Task(data = shifted_data, covariates = c(a_names, w_names), outcome = outcome))
-    effect <- mean(data[[outcome]] - predictions)
+    effect <- mean(predictions - data[[outcome]])
     individual_effects_df <- rbind(individual_effects_df, data.frame(Variable = var, Effect = effect))
   }
 
   # Rank individual effects
   individual_effects_df <- individual_effects_df[order(-individual_effects_df$Effect), ]
-  top_positive_effects <- head(individual_effects_df[individual_effects_df$Effect > 0, ], top_n)
-  top_negative_effects <- tail(individual_effects_df[individual_effects_df$Effect < 0, ], top_n)
+  top_positive_effects <- head(individual_effects_df, top_n)
+  top_negative_effects <- tail(individual_effects_df, top_n)
 
   top_positive_effects$Rank <- seq(top_n)
-  top_negative_effects$Rank <- seq(top_n)
+  top_negative_effects$Rank <- rev(seq(top_n))
 
   # Calculate interaction effects
   for (indices in combn(seq_along(a_names), 2, simplify = FALSE)) {
@@ -93,11 +93,11 @@ find_synergy_antagonism <- function(data, deltas, a_names, w_names, outcome, out
 
   # Rank interaction effects
   interaction_effects_df <- interaction_effects_df[order(-interaction_effects_df$Effect), ]
-  top_synergistic_interactions <- head(interaction_effects_df[interaction_effects_df$Effect > 0, ], top_n)
-  top_antagonistic_interactions <- tail(interaction_effects_df[interaction_effects_df$Effect < 0, ], top_n)
+  top_synergistic_interactions <- head(interaction_effects_df, top_n)
+  top_antagonistic_interactions <- tail(interaction_effects_df, top_n)
 
   top_synergistic_interactions$Rank <- seq(top_n)
-  top_antagonistic_interactions$Rank <- seq(top_n)
+  top_antagonistic_interactions$Rank <- rev(seq(top_n))
 
   # Return the results
   return(list(