v0.6.0

.github/workflows/R-CMD-check.yaml

@@ -0,0 +1,48 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check
+
+permissions: read-all
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: ubuntu-latest,   r: 'release'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

DESCRIPTION

@@ -1,26 +1,30 @@
 Package: CohortSurvival
 Title: Estimate Survival from Common Data Model Cohorts
-Version: 0.5.1
+Version: 0.6.0
 Authors@R: c(
     person("Edward", "Burn", email = "[email protected]", 
     role = c("aut", "cre"), 
     comment = c(ORCID = "0000-0002-9286-1128")), 
-    person("Kim", "Lopez", email = "[email protected]", role = c("aut"),
+    person("Kim", "López-Güell", email = "[email protected]", 
+    role = c("aut"),
     comment = c(ORCID = "0000-0002-8462-8668")),
     person("Marti", "Catala", email = "[email protected]", 
-    role = c("ctb"), 
+    role = c("aut"), 
     comment = c(ORCID = "0000-0003-3308-9905")),
     person("Xintong", "Li", email = "[email protected]", 
-    role = c("ctb"), 
-    comment = c(ORCID = "0000-0003-3308-9905")),
+    role = c("aut"), 
+    comment = c(ORCID = "0000-0002-6872-5804")),
     person("Danielle", "Newby", email = "[email protected]", 
-    role = c("ctb"), 
-    comment = c(ORCID = "0000-0002-3001-1478")))
+    role = c("aut"), 
+    comment = c(ORCID = "0000-0002-3001-1478")),
+    person("Nuria", "Mercade-Besora", , "[email protected]", 
+    role = c("aut"), 
+    comment = c(ORCID = "0009-0006-7948-3747")))
 Description: Estimate survival using data mapped to the Observational Medical Outcomes Partnership common data model. Survival can be estimated based on user-defined study cohorts.
 License: Apache License (>= 2)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Imports: 
     CDMConnector (>= 1.3.0),
     omopgenerics (>= 0.2.0),
@@ -35,11 +39,13 @@ Imports:
     PatientProfiles,
     visOmopResults (>= 0.3.0),
     rlang (>= 0.4.11),
-    survival,
+    survival (>= 3.7.0),
     scales,
     stringr,
     tibble,
-    tidyr
+    tidyr,
+    purrr, 
+    lifecycle
 Suggests: 
     testthat (>= 3.0.0),
     CodelistGenerator,

NAMESPACE

@@ -8,18 +8,32 @@ export(addCompetingRiskCohortSurvival)
 export(asSurvivalResult)
 export(as_label)
 export(as_name)
-export(benchmarkCohortSurvival)
+export(attrition)
+export(bind)
+export(cohortCodelist)
+export(cohortCount)
 export(enquo)
 export(enquos)
 export(estimateCompetingRiskSurvival)
 export(estimateSingleEventSurvival)
+export(exportSummarisedResult)
 export(generateDeathCohortSet)
+export(importSummarisedResult)
 export(mockMGUS2cdm)
 export(optionsTableSurvival)
 export(plotSurvival)
-export(survivalParticipants)
+export(settings)
+export(suppress)
 export(tableSurvival)
 importFrom(magrittr,"%>%")
+importFrom(omopgenerics,attrition)
+importFrom(omopgenerics,bind)
+importFrom(omopgenerics,cohortCodelist)
+importFrom(omopgenerics,cohortCount)
+importFrom(omopgenerics,exportSummarisedResult)
+importFrom(omopgenerics,importSummarisedResult)
+importFrom(omopgenerics,settings)
+importFrom(omopgenerics,suppress)
 importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,.env)

R/addCohortSurvival.R

@@ -81,23 +81,37 @@ addCohortSurvival <- function(x,
       futureObservationName = "days_to_exit"
     ) %>% dplyr::compute()
 
-  # get any events before or after index date
-  x <- x %>%
-    PatientProfiles::addCohortIntersectFlag(
-      indexDate = "cohort_start_date",
-      targetCohortTable = outcomeCohortTable,
-      targetCohortId = outcomeCohortId,
-      window = c(-outcomeWashout,-1),
-      nameStyle = "event_in_washout"
-    ) %>%
-    PatientProfiles::addCohortIntersectDays(
-      indexDate = "cohort_start_date",
-      targetCohortTable = outcomeCohortTable,
-      targetCohortId = outcomeCohortId,
-      targetDate = outcomeDateVariable,
-      window = c(0, Inf),
-      nameStyle = "days_to_event"
-    ) %>% dplyr::compute()
+  if(outcomeWashout == 0) {
+    # get any events before or after index date
+    x <- x %>%
+      dplyr::mutate(event_in_washout = 0L) %>%
+      PatientProfiles::addCohortIntersectDays(
+        indexDate = "cohort_start_date",
+        targetCohortTable = outcomeCohortTable,
+        targetCohortId = outcomeCohortId,
+        targetDate = outcomeDateVariable,
+        window = c(0, Inf),
+        nameStyle = "days_to_event"
+      ) %>% dplyr::compute()
+  } else {
+    # get any events before or after index date
+    x <- x %>%
+      PatientProfiles::addCohortIntersectFlag(
+        indexDate = "cohort_start_date",
+        targetCohortTable = outcomeCohortTable,
+        targetCohortId = outcomeCohortId,
+        window = c(-outcomeWashout,-1),
+        nameStyle = "event_in_washout"
+      ) %>%
+      PatientProfiles::addCohortIntersectDays(
+        indexDate = "cohort_start_date",
+        targetCohortTable = outcomeCohortTable,
+        targetCohortId = outcomeCohortId,
+        targetDate = outcomeDateVariable,
+        window = c(0, Inf),
+        nameStyle = "days_to_event"
+      ) %>% dplyr::compute()
+  }
 
   # whatever comes first
 
@@ -352,42 +366,15 @@ validateExtractSurvivalInputs <- function(cdm,
                                           censorOnCohortExit,
                                           censorOnDate,
                                           followUpDays) {
-  checkCdm(cdm, tables = c(
-    "person", "observation_period",
-    outcomeCohortTable
-  ))
-
-  checkIsCohort_exp(cohortTable)
+  omopgenerics::validateCdmArgument(cdm)
+  omopgenerics::validateCohortArgument(cdm[[outcomeCohortTable]])
   checkExposureCohortId(cohortTable)
-
-  checkIsCohort(cdm[[outcomeCohortTable]])
-
+  omopgenerics::assertDate(censorOnDate, null = TRUE, )
   checkCensorOnDate(cohortTable, censorOnDate)
-
-  errorMessage <- checkmate::makeAssertCollection()
-  checkmate::assertIntegerish(outcomeCohortId,
-    len = 1,
-    add = errorMessage
-  )
-  checkmate::assert_logical(censorOnCohortExit)
-  checkmate::assert_date(censorOnDate, null.ok = TRUE)
-  if (followUpDays != Inf) {
-    checkmate::assert_integerish(followUpDays,
-      len = 1,
-      lower = 1,
-      add = errorMessage
-    )
-  }
-  if (outcomeWashout != "Inf") {
-    checkmate::assertIntegerish(outcomeWashout,
-                                len = 1,
-                                lower = 1,
-                                add = errorMessage
-    )
-  }
-  checkmate::reportAssertions(collection = errorMessage)
-
-
+  omopgenerics::assertNumeric(outcomeCohortId, length = 1, min = 1)
+  omopgenerics::assertLogical(censorOnCohortExit, length = 1)
+  omopgenerics::assertNumeric(followUpDays, length = 1, min = 1, integerish = TRUE)
+  omopgenerics::assertNumeric(outcomeWashout, length = 1, min = 0, integerish = TRUE)
 
   # check specified cohort is in cohort table
   errorMessage <- checkmate::makeAssertCollection()

R/asSurvivalResult.R

@@ -43,38 +43,54 @@ asSurvivalResult <- function(result) {
     cli::cli_abort("result is not a valid `summarised_result` object.")
   }
   result <- result %>%
-    visOmopResults::addSettings() %>%
-    #    suppress(minCellCount = minCellCount) %>%
-    dplyr::select(-c("package_name", "package_version", "estimate_type")) %>%
+     visOmopResults::addSettings() %>%
+     dplyr::select(c("cdm_name", "group_name", "group_level", "strata_name",
+                     "strata_level", "variable_name", "variable_level",
+                     "estimate_name", "estimate_type", "estimate_value",
+                     "additional_name", "additional_level", "result_type",
+                     "outcome", "competing_outcome",
+                     "eventgap")) %>%
     visOmopResults::splitAdditional() %>%
     visOmopResults::splitGroup() %>%
     dplyr::mutate(estimate_value = as.numeric(.data$estimate_value))
+
   estimates <- result %>%
-    dplyr::filter(.data$variable_name %in%
+    dplyr::filter(.data$result_type %in%
                     c("survival_probability",
                       "cumulative_failure_probability")) %>%
-    dplyr::select(-dplyr::any_of('eventgap')) %>%
-    dplyr::mutate(time = as.numeric(.data$time))
-  if("competing_outcome" %in% colnames(estimates)) {
-    estimates <- estimates %>%
-      dplyr::relocate("outcome", .after = "cohort") %>%
+    dplyr::select(-dplyr::any_of(c("eventgap", "reason_id"))) %>%
+    dplyr::mutate(time = as.numeric(.data$time)) %>%
+      dplyr::relocate("outcome", .after = "target_cohort") %>%
       dplyr::relocate("competing_outcome", .after = "outcome")
-  } else {
-    estimates <- estimates %>%
-      dplyr::relocate("outcome", .after = "cohort")
-  }
+
   summary <- result %>%
-    dplyr::filter(.data$variable_name == 'survival_summary') %>%
-    dplyr::select(-dplyr::any_of(c('variable_name', 'time', 'eventgap')))
+    dplyr::filter(.data$result_type == "survival_summary") %>%
+    dplyr::select(-dplyr::any_of(c("variable_name", "time", "eventgap", "result_type", "reason_id"))) %>%
+    dplyr::mutate(estimate_name = dplyr::if_else(
+      grepl("count", .data$estimate_name),
+      gsub("_count","",.data$estimate_name),
+      .data$estimate_name
+    ))
+
   events <- result %>%
-    dplyr::filter(.data$variable_name == 'survival_events') %>%
-    dplyr::select(-dplyr::any_of('variable_name')) %>%
+    dplyr::filter(.data$result_type == "survival_events") %>%
+    dplyr::select(-dplyr::any_of(c("reason_id", "result_type"))) %>%
     dplyr::distinct() %>%
-    dplyr::mutate(time = as.numeric(.data$time))
+    dplyr::mutate(time = as.numeric(.data$time)) %>%
+    dplyr::mutate(estimate_name = dplyr::if_else(
+      grepl("count", .data$estimate_name),
+      gsub("_count","",.data$estimate_name),
+      .data$estimate_name
+    ))
+
+  attrition <- result %>%
+    dplyr::filter(.data$result_type == "survival_attrition") %>%
+    dplyr::select(-c("result_type", "time", "eventgap"))
 
   result_final <- estimates
-  attr(result_final, 'events') <- events
-  attr(result_final, 'summary') <- summary
+  attr(result_final, "events") <- events
+  attr(result_final, "summary") <- summary
+  attr(result_final, "attrition") <- attrition
 
   return(result_final)
 }