Merge pull request #46 from opensafely-actions/make-v0.0.30

Make v0.0.30
opensafely-actions · Nov 21, 2023 · 8495b99 · 8495b99
2 parents 0446a6d + c9d2d04
commit 8495b99
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 2 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,3 +1,7 @@
+# [v0.0.30](https://github.com/opensafely-actions/cox-ipw/releases/tag/v0.0.30)
+
+- Add an observation warning that returns a message if the number of observations provided to the model differs from the number of observations used by the model.
+
 # [v0.0.29](https://github.com/opensafely-actions/cox-ipw/releases/tag/v0.0.29)
 
 - The r image has been reverted to use the old version of the **readr** package. Hence, the `path` argument is now used again in the calls to `readr::write_csv()`.

diff --git a/analysis/cox-ipw.R b/analysis/cox-ipw.R
@@ -429,6 +429,7 @@ if (sum(episode_info[episode_info$time_period != "days_pre", ]$N_events) < total
                       surv_formula = c(results[results$model=="mdl_age_sex",]$surv_formula[1], results[results$model=="mdl_max_adj",]$surv_formula[1]),
                       covariate_removed = "",
                       covariate_collapsed = "",
+                      obs_warning = "",
                       N_events = episode_info[episode_info$time_period == "days_pre", ]$N_events,
                       person_time_total = episode_info[episode_info$time_period == "days_pre",]$person_time_total,
                       outcome_time_median = episode_info[episode_info$time_period == "days_pre",]$outcome_time_median,
@@ -455,14 +456,14 @@ if (sum(episode_info[episode_info$time_period != "days_pre", ]$N_events) < total
 
     results$strata_warning <- strata_warning
 
-    results$cox_ipw <- "v0.0.29"
+    results$cox_ipw <- "v0.0.30"
 
     results <- results[order(results$model),
                        c("model", "exposure", "outcome", "term",
                          "lnhr","se_lnhr", "hr","conf_low", "conf_high", 
                          "N_total", "N_exposed", "N_events", 
                          "person_time_total", "outcome_time_median",
-                         "covariate_collapsed","strata_warning",
+                         "covariate_collapsed","strata_warning","obs_warning",
                          "surv_formula","input","cox_ipw")]
   } else {
 

diff --git a/analysis/fn-fit_model.R b/analysis/fn-fit_model.R
@@ -44,6 +44,8 @@ fit_model <- function(df, time_periods, covariates, strata, age_spline, covariat
 
   if (ipw==TRUE) {
 
+    N_obs_in <- nrow(df)
+
     fit_cox_model <- rms::cph(formula = as.formula(surv_formula),
                               data = df, 
                               weight = df$cox_weight,
@@ -52,15 +54,21 @@ fit_model <- function(df, time_periods, covariates, strata, age_spline, covariat
                               x = TRUE,
                               y = TRUE)
 
+    N_obs_out <- sum(fit_cox_model$n)
+
   } else {
 
+    N_obs_in <- nrow(df)
+
     fit_cox_model <- rms::cph(formula = as.formula(surv_formula),
                               data = df, 
                               method = "breslow",
                               surv = TRUE,
                               x = TRUE,
                               y = TRUE)
 
+    N_obs_out <- sum(fit_cox_model$n)
+
   }
 
   print(fit_cox_model)
@@ -75,6 +83,7 @@ fit_model <- function(df, time_periods, covariates, strata, age_spline, covariat
                         surv_formula = surv_formula,
                         covariate_removed = "", 
                         covariate_collapsed = "",
+                        obs_warning = ifelse(N_obs_in==N_obs_out,"",paste0(N_obs_in," observations provided. ",N_obs_out," observations used.")),
                         stringsAsFactors = FALSE)
 
   row.names(results) <- NULL
@@ -102,6 +111,8 @@ fit_model <- function(df, time_periods, covariates, strata, age_spline, covariat
 
     if (ipw==TRUE) {
 
+      N_obs_in <- nrow(df)
+
       fit_cox_model_adj <- rms::cph(formula = as.formula(surv_formula_adj),
                                     data = df, 
                                     weight = df$cox_weight,
@@ -110,29 +121,37 @@ fit_model <- function(df, time_periods, covariates, strata, age_spline, covariat
                                     x = TRUE,
                                     y = TRUE)
 
+      N_obs_out <- sum(fit_cox_model$n)
+
     } else {
 
+      N_obs_in <- nrow(df)
+
       fit_cox_model_adj <- rms::cph(formula = as.formula(surv_formula_adj),
                                     data = df, 
                                     method = "breslow",
                                     surv = TRUE,
                                     x = TRUE,
                                     y = TRUE)
 
+      N_obs_out <- sum(fit_cox_model$n)
+
     }
 
     print(fit_cox_model_adj)
 
     # Format results ---------------------------------------------------------------
     print("Format results")
 
+
     results_adj <- data.frame(term = names(fit_cox_model_adj$coefficients),
                               lnhr = fit_cox_model_adj$coefficients,
                               se_lnhr = sqrt(diag(vcov(fit_cox_model_adj))),
                               model = "mdl_max_adj",
                               surv_formula = surv_formula_adj,
                               covariate_removed = paste0(covariate_removed, collapse = ";"),
                               covariate_collapsed = paste0(covariate_collapsed, collapse = ";"),
+                              obs_warning = ifelse(N_obs_in==N_obs_out,"",paste0(N_obs_in," observations provided. ",N_obs_out," observations used.")),
                               stringsAsFactors = FALSE)
 
     row.names(results_adj) <- NULL