From 30e6085909b022b278c8346f5d37e1cb898c79f2 Mon Sep 17 00:00:00 2001 From: edward-burn <9583964+edward-burn@users.noreply.github.com> Date: Wed, 20 Sep 2023 05:18:19 +0100 Subject: [PATCH] v0.1.1 --- DESCRIPTION | 2 +- R/estimateSurvival.R | 32 ++++++++++++--------- R/generateDeathCohort.R | 6 ++-- tests/testthat/test-estimateSurvival.R | 40 +++++++++++++------------- 4 files changed, 44 insertions(+), 36 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index fc0a043..7dfe4aa 100644 --- 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 = "edward.burn@ndorms.ox.ac.uk", role = c("aut", "cre"), diff --git a/R/estimateSurvival.R b/R/estimateSurvival.R index 823cb2d..30cdca0 100644 --- 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 index 3dd2efb..5386a19 100644 --- 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 index 7183e3d..b9f2ab6 100644 --- 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) })