Update Cumulative Treatment Effect

Added cumulative treatment effect calculation to the functions `bayesmsm` and `calculate_effect` with their corresponding documentation, examples, and tests.

R/calculate_effect.R

@@ -3,29 +3,34 @@
 #' @param intervention_levels A numeric vector indicating the levels of intervention for each predictor variable.
 #' @param variables A list of the names of the response variable and predictor variables extracted from the model.
 #' @param param_estimates A vector of parameter estimates from the model.
+#' @param treatment_effect_type Character string specifying the type of treatment effect to estimate. Options are "sq" for sequential treatment effects, which estimates effects for specific treatment sequences across visits, and "cum" for cumulative treatment effects, which assumes a single cumulative treatment variable representing the total exposure. The default is "sq".
 #'
 #' @return A numeric value representing the calculated effect of the specified intervention.
 #'
-calculate_effect <- function(intervention_levels, variables, param_estimates) {
-  # Start with the intercept term
-  effect<-effect_intercept<-param_estimates[1]
+calculate_effect <- function(intervention_levels, variables, param_estimates, treatment_effect_type) {
+  if (treatment_effect_type == "cum") {
+    # For cumulative treatment, only consider b1
+    effect <- param_estimates[1] * intervention_levels[1]
+  } else {
+    # Start with the intercept term
+    effect<-effect_intercept<-param_estimates[1]
 
-  # Go through each predictor and add its contribution
-  for (i in 1:length(variables$predictors)) {
-    term <- variables$predictors[i]
-    term_variables <- unlist(strsplit(term, ":"))
-    term_index <- which(names(param_estimates) == term)
+    # Go through each predictor and add its contribution
+    for (i in 1:length(variables$predictors)) {
+      term <- variables$predictors[i]
+      term_variables <- unlist(strsplit(term, ":"))
+      term_index <- which(names(param_estimates) == term)
 
-    # Calculate the product of intervention levels for the interaction term
-    term_contribution <- param_estimates[term_index]
-    for (term_variable in term_variables) {
-      var_index <- which(variables$predictors == term_variable)
-      term_contribution <- term_contribution * intervention_levels[var_index]
-    }
+      # Calculate the product of intervention levels for the interaction term
+      term_contribution <- param_estimates[term_index]
+      for (term_variable in term_variables) {
+        var_index <- which(variables$predictors == term_variable)
+        term_contribution <- term_contribution * intervention_levels[var_index]
+      }
 
-    # Add the term contribution to the effect
-    effect <- effect + term_contribution
+      # Add the term contribution to the effect
+      effect <- effect + term_contribution
+    }
   }
-
   return(effect)
 }

R/plot_APO.R

@@ -20,6 +20,7 @@
 #'                            nvisit = 2,
 #'                            reference = c(rep(0,2)),
 #'                            comparator = c(rep(1,2)),
+#'                            treatment_effect_type = "sq",
 #'                            family = "gaussian",
 #'                            data = testdata,
 #'                            wmean = rep(1, 1000),

R/plot_ATE.R

@@ -24,6 +24,7 @@
 #'                            nvisit = 2,
 #'                            reference = c(rep(0,2)),
 #'                            comparator = c(rep(1,2)),
+#'                            treatment_effect_type = "sq",
 #'                            family = "gaussian",
 #'                            data = testdata,
 #'                            wmean = rep(1, 1000),

R/plot_est_box.R

@@ -17,6 +17,7 @@
 #'                            nvisit = 2,
 #'                            reference = c(rep(0,2)),
 #'                            comparator = c(rep(1,2)),
+#'                            treatment_effect_type = "sq",
 #'                            family = "gaussian",
 #'                            data = testdata,
 #'                            wmean = rep(1, 1000),

R/summary_bayesmsm.R

@@ -13,6 +13,7 @@
 #'                            nvisit = 2,
 #'                            reference = c(rep(0,2)),
 #'                            comparator = c(rep(1,2)),
+#'                            treatment_effect_type = "sq",
 #'                            family = "gaussian",
 #'                            data = testdata,
 #'                            wmean = rep(1, 1000),

tests/testthat/test-bayesmsm.R

@@ -9,6 +9,7 @@ test_that("bayesmsm works with no errors", {
                       nvisit = 2,
                       reference = c(rep(0,2)),
                       comparator = c(rep(1,2)),
+                      treatment_effect_type = "sq",
                       family = "gaussian",
                       data = testdata,
                       wmean = rep(1, 1000),

tests/testthat/test-plot_APO.R

@@ -6,6 +6,7 @@ test_that("plot_APO works with no errors", {
                     nvisit = 2,
                     reference = c(rep(0,2)),
                     comparator = c(rep(1,2)),
+                    treatment_effect_type = "sq",
                     family = "gaussian",
                     data = testdata,
                     wmean = rep(1, 1000),

tests/testthat/test-plot_ATE.R

@@ -6,6 +6,7 @@ test_that("plot_ATE works with no errors", {
                     nvisit = 2,
                     reference = c(rep(0,2)),
                     comparator = c(rep(1,2)),
+                    treatment_effect_type = "sq",
                     family = "gaussian",
                     data = testdata,
                     wmean = rep(1, 1000),

tests/testthat/test-plot_est_box.R

@@ -6,6 +6,7 @@ test_that("plot_est_box works with no errors", {
                     nvisit = 2,
                     reference = c(rep(0,2)),
                     comparator = c(rep(1,2)),
+                    treatment_effect_type = "sq",
                     family = "gaussian",
                     data = testdata,
                     wmean = rep(1, 1000),