v0.1.1

darwin-eu · Sep 20, 2023 · 30e6085 · 30e6085
1 parent d8ab252
commit 30e6085
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 36 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: CohortSurvival
 Title: Estimate survival using the OMOP Common Data Model
-Version: 0.1
+Version: 0.1.1
 Authors@R: c(
     person("Edward", "Burn", email = "[email protected]", 
     role = c("aut", "cre"), 

diff --git a/R/estimateSurvival.R b/R/estimateSurvival.R
@@ -740,12 +740,24 @@ competingRiskSurvival <- function(survData, times, variables, timeGap) {
                       "restricted_mean"= "rmean",
                       "n_events"= "nevent") %>%
         dplyr::mutate(analysis_type = "competing risk") %>%
-        dplyr::mutate(strata_name = "Overall",
-                      strata_level = "Overall") %>%
-        tibble::rownames_to_column(var = "outcome") %>%
-        dplyr::mutate(outcome = dplyr::if_else(.data$outcome == "(s0)", "none",
-                                               dplyr::if_else(.data$outcome == "1",
-                                                              "outcome", "competing outcome")))
+        dplyr::mutate(rowname = rownames(.)) %>%
+        dplyr::mutate(
+          strata_name = paste(name, collapse = " and "),
+          strata_level = gsub(", "," and ",gsub(paste(paste0(name,"="),
+                                                      collapse="|"),"",
+                                                row.names(.)))
+        ) %>%
+        dplyr::mutate(
+          outcome = gsub("^.*and", "", strata_level)
+        ) %>%
+        dplyr::mutate(
+          strata_level = gsub("and ([^and ]*)$", "", strata_level)
+        ) %>%
+        dplyr::mutate(strata_level = gsub("[[:space:]]*$","",strata_level)) %>%
+        dplyr::mutate(outcome = dplyr::if_else(.data$outcome == " (s0)", "none",
+                                               dplyr::if_else(.data$outcome == " 1",
+                                                              "outcome", "competing outcome"))) %>%
+          dplyr::select(-c("rowname"))
 
       estimates[[i+1]] <- dplyr::bind_rows(
         dplyr::bind_cols(
@@ -801,13 +813,7 @@ competingRiskSurvival <- function(survData, times, variables, timeGap) {
           dplyr::mutate(strata_level= stringr::str_replace(string = .data$strata_level,
                                                            pattern = ",",
                                                            replacement = " and"))
-        fitSummary[[i+1]] <- fitSummary[[i+1]] %>%
-          dplyr::mutate(
-            strata_name = paste(name, collapse = " and "),
-            strata_level = gsub(", "," and ",gsub(paste(paste0(name,"="),
-                                                        collapse="|"),"",
-                                                  row.names(fitSummary[[i+1]])))
-          )
+
       }
     }
     cli::cli_progress_done()

diff --git a/R/generateDeathCohort.R b/R/generateDeathCohort.R
@@ -116,8 +116,10 @@ generateDeathCohortSet <- function(
   cdm[[name]] <- CDMConnector::newGeneratedCohortSet(
     cohortRef = cohortRef,
     cohortSetRef = cohortSetRef,
-    cohortCountRef = cohortCountRef
-  )}
+    cohortCountRef = cohortCountRef,
+    overwrite = TRUE
+  )
+  }
 
   attr(cdm[[name]], "cohort_attrition") <- tibble::tibble(
     "reason" = "Qualifying initial records",

diff --git a/tests/testthat/test-estimateSurvival.R b/tests/testthat/test-estimateSurvival.R
@@ -136,18 +136,18 @@ test_that("mgus example: Competing risk, strata", {
   cdm[["mgus_diagnosis"]] <- cdm[["mgus_diagnosis"]] %>%
     dplyr::mutate(mspike_r = round(mspike, digits = 0))
   survCR <- estimateSurvival(cdm,
-    targetCohortTable = "mgus_diagnosis",
-    targetCohortId = 1,
-    outcomeCohortTable = "death_cohort",
-    outcomeCohortId = 1,
-    competingOutcomeCohortTable = "progression",
-    competingOutcomeCohortId = 1,
-    strata = list(
-      "age" = c("age"),
-      "sex" = c("sex"),
-      "age and sex" = c("age", "sex"),
-      "mspike rounded" = c("mspike_r")
-    )
+                             targetCohortTable = "mgus_diagnosis",
+                             targetCohortId = 1,
+                             outcomeCohortTable = "death_cohort",
+                             outcomeCohortId = 1,
+                             competingOutcomeCohortTable = "progression",
+                             competingOutcomeCohortId = 1,
+                             strata = list(
+                               "age" = c("age"),
+                               "sex" = c("sex"),
+                               "age and sex" = c("age", "sex"),
+                               "mspike rounded" = c("mspike_r")
+                             )
   )
 
   # problem with strata variables (age up to 300)
@@ -157,18 +157,18 @@ test_that("mgus example: Competing risk, strata", {
   expect_true(all(compareNA(survCR %>% dplyr::select(time) %>% dplyr::pull() %>% unique(), c(0:424,NA))))
   expect_true(survCR %>% dplyr::select(analysis_type) %>% dplyr::pull() %>% unique() == "Competing risk")
   expect_true(all(survCR %>% dplyr::select(strata_name) %>% dplyr::pull() %>% unique() %in% c("Overall", "sex", "age", "mspike_r", "age and sex")))
-#  expect_true(all(survCR %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
-#    "M", "F", 0, 1, 2, 3, c(24:96), "Overall",
-#    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " and ")
-#  )))
+  expect_true(all(survCR %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
+    "M", "F", 0, 1, 2, 3, c(24:96), "Overall",
+    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " and ")
+  )))
 
   expect_true(all(survCR %>% dplyr::filter(estimate_type == "Survival events") %>% dplyr::select(variable_level) %>% dplyr::pull() %>% unique() %in% c("timeGap 1", "timeGap 7", "timeGap 30", "timeGap 365")))
   expect_true(all(survCR %>% dplyr::filter(estimate_type == "Survival events") %>% dplyr::select(time) %>% dplyr::pull() %>% unique() == c(0:424)))
   expect_true(all(survCR %>% dplyr::filter(estimate_type == "Survival events") %>% dplyr::select(strata_name) %>% dplyr::pull() %>% unique() %in% c("Overall", "sex", "age", "mspike_r", "age and sex")))
-#  expect_true(all(survCR %>% dplyr::filter(estimate_type == "Survival events") %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
-#    "M", "F", 0, 1, 2, 3, c(24:96), "Overall",
-#    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " and ")
-#  )))
+  expect_true(all(survCR %>% dplyr::filter(estimate_type == "Survival events") %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
+    "M", "F", 0, 1, 2, 3, c(24:96), "Overall",
+    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " and ")
+  )))
 
   CDMConnector::cdmDisconnect(cdm)
 })