Move variable_level to additional_level in RecordCount and InObservation

OHDSI · Nov 5, 2024 · c653d94 · c653d94
1 parent 632168f
commit c653d94
Show file tree

Hide file tree

Showing 9 changed files with 111 additions and 92 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: OmopSketch
 Title: Characterise Tables of an OMOP Common Data Model Instance
-Version: 0.1.1
+Version: 0.1.2
 Authors@R: c(
     person( 
         "Marta", "Alcalde-Herraiz", 

diff --git a/R/plotInObservation.R b/R/plotInObservation.R
@@ -52,15 +52,15 @@ plotInObservation <- function(result,
   }
 
   # warn
-  warnFacetColour(result, list(facet = asCharacterFacet(facet), colour = colour, "variable_level"))
+  warnFacetColour(result, list(facet = asCharacterFacet(facet), colour = colour, "additional_level"))
 
   # plot
-  if(length(unique(result$variable_level)) > 1 ){
+  if(length(unique(result$additional_level)) > 1 ){
     result |>
-      dplyr::mutate(variable_level = as.Date(gsub(" to.*","",.data$variable_level))) |>
+      dplyr::mutate(additional_level = as.character(gsub("-01$","",as.Date(gsub(" to.*","",.data$additional_level))))) |>
       dplyr::filter(.data$estimate_name == "count") |>
       visOmopResults::scatterPlot(
-        x = "variable_level",
+        x = "time_interval",
         y = "count",
         line = TRUE,
         point = TRUE,

diff --git a/R/plotRecordCount.R b/R/plotRecordCount.R
@@ -38,12 +38,12 @@ plotRecordCount <- function(result,
   }
 
   # Detect if there are several time intervals
-  if(length(unique(result$variable_level)) > 1 ){
+  if(length(unique(result$additional_level)) > 1 ){
     # Line plot where each concept is a different line
     p <- result |>
-      dplyr::filter(.data$variable_level != "overall") |>
+      dplyr::filter(.data$additional_level != "overall") |>
       dplyr::filter(.data$estimate_name == "count") |>
-      visOmopResults::scatterPlot(x = "variable_level",
+      visOmopResults::scatterPlot(x = "time_interval",
                                   y = "count",
                                   line   = TRUE,
                                   point  = TRUE,
@@ -57,7 +57,7 @@ plotRecordCount <- function(result,
       )
   }else{
     p <- result |>
-      visOmopResults::barPlot(x = "variable_level",
+      visOmopResults::barPlot(x = "additional_level",
                               y = "count",
                               facet = facet,
                               colour = colour)  +

diff --git a/R/summariseInObservation.R b/R/summariseInObservation.R
@@ -52,6 +52,7 @@ summariseInObservation <- function(observationPeriod,
   checkOutput(output)
   ageGroup <- omopgenerics::validateAgeGroupArgument(ageGroup, ageGroupName = "")[[1]]
   omopgenerics::assertLogical(sex, length = 1)
+  original_interval <- interval
   x <- validateIntervals(interval)
   interval <- x$interval
   unitInterval <- x$unitInterval
@@ -88,7 +89,7 @@ summariseInObservation <- function(observationPeriod,
   result <- addSexOverall(result, sex)
 
   # Create summarisedResult
-  result <- createSummarisedResultObservationPeriod(result, observationPeriod, name, denominator, interval, unitInterval)
+  result <- createSummarisedResultObservationPeriod(result, observationPeriod, name, denominator, original_interval)
 
   CDMConnector::dropTable(cdm, name = dplyr::starts_with(tablePrefix))
   return(result)
@@ -172,7 +173,7 @@ countRecords <- function(observationPeriod, cdm, start_date_name, end_date_name,
   if(output == "person-days" | output == "all"){
     if(interval != "overall"){
       x <- cdm[[paste0(tablePrefix, "interval")]] |>
-        dplyr::rename("variable_level" = "interval_group") |>
+        dplyr::rename("additional_level" = "interval_group") |>
         dplyr::cross_join(
           observationPeriod |>
             dplyr::select("start_date" = "observation_period_start_date",
@@ -188,14 +189,16 @@ countRecords <- function(observationPeriod, cdm, start_date_name, end_date_name,
       x <- observationPeriod |>
         dplyr::rename("start_date" = "observation_period_start_date",
                       "end_date"   = "observation_period_end_date") |>
-        dplyr::mutate("variable_level" = NA)
+        dplyr::mutate("additional_level" = "overall",
+                      "additional_name"  = "overall")
     }
 
     personDays <- x %>%
       dplyr::mutate(estimate_value = !!CDMConnector::datediff("start_date","end_date", interval = "day")+1) |>
-      dplyr::group_by(dplyr::across(dplyr::any_of(c("variable_level", "sex", "age_group")))) |>
+      dplyr::group_by(dplyr::across(dplyr::any_of(c("additional_level", "sex", "age_group")))) |>
       dplyr::summarise(estimate_value = sum(.data$estimate_value, na.rm = TRUE), .groups = "drop") |>
-      dplyr::mutate(variable_name = "Number person-days") |>
+      dplyr::mutate("variable_name" = "Number person-days",
+                    "additional_name" = "time_interval") |>
       dplyr::collect()
   }else{
     personDays <- createEmptyIntervalTable(interval)
@@ -212,20 +215,22 @@ if(output == "records" | output == "all"){
         dplyr::compute(temporary = FALSE, name = tablePrefix)
 
       records <- cdm[[paste0(tablePrefix, "interval")]] |>
-        dplyr::rename("variable_level" = "interval_group") |>
+        dplyr::rename("additional_level" = "interval_group") |>
         dplyr::cross_join(x) |>
         dplyr::filter((.data$start_date < .data$interval_start_date & .data$end_date >= .data$interval_start_date) |
                         (.data$start_date >= .data$interval_start_date & .data$start_date <= .data$interval_end_date)) |>
-        dplyr::group_by(.data$variable_level, .data$age_group, .data$sex) |>
+        dplyr::group_by(.data$additional_level, .data$age_group, .data$sex) |>
         dplyr::summarise(estimate_value = sum(.data$estimate_value, na.rm = TRUE), .groups = "drop") |>
-        dplyr::mutate(variable_name = "Number records in observation") |>
+        dplyr::mutate("variable_name" = "Number records in observation",
+                      "additional_name" = "time_interval") |>
         dplyr::collect()
     }else{
       records <- observationPeriod |>
         dplyr::group_by(.data$age_group, .data$sex) |>
         dplyr::summarise(estimate_value = dplyr::n(), .groups = "drop") |>
         dplyr::mutate("variable_name" = "Number records in observation",
-                      "variable_level" = NA) |>
+                      "additional_level" = "overall",
+                      "additional_name"  = "overall") |>
         dplyr::collect()
     }
   }else{
@@ -234,12 +239,12 @@ if(output == "records" | output == "all"){
 
   x <- personDays |>
     rbind(records) |>
-    dplyr::arrange(dplyr::across(dplyr::any_of("variable_level")))
+    dplyr::arrange(dplyr::across(dplyr::any_of("additional_level")))
 
   return(x)
 }
 
-createSummarisedResultObservationPeriod <- function(result, observationPeriod, name, denominator, interval, unitInterval){
+createSummarisedResultObservationPeriod <- function(result, observationPeriod, name, denominator, original_interval){
   result <- result |>
     dplyr::mutate("estimate_value" = as.character(.data$estimate_value)) |>
     visOmopResults::uniteStrata(cols = c("sex", "age_group")) |>
@@ -248,15 +253,14 @@ createSummarisedResultObservationPeriod <- function(result, observationPeriod, n
       "cdm_name" = omopgenerics::cdmName(omopgenerics::cdmReference(observationPeriod)),
       "group_name"  = "omop_table",
       "group_level" = name,
+      "variable_level" = as.character(NA),
       "estimate_name" = "count",
-      "estimate_type" = "integer",
-      "additional_name" = "overall",
-      "additional_level" = "overall"
+      "estimate_type" = "integer"
     )
 
   result <- result |>
     rbind(result) |>
-    dplyr::group_by(.data$variable_level, .data$strata_level, .data$variable_name) |>
+    dplyr::group_by(.data$additional_level, .data$strata_level, .data$variable_name) |>
     dplyr::mutate(estimate_type = dplyr::if_else(dplyr::row_number() == 2, "percentage", .data$estimate_type)) |>
     dplyr::inner_join(denominator, by = "variable_name") |>
     dplyr::mutate(estimate_value = dplyr::if_else(.data$estimate_type == "percentage", as.character(as.numeric(.data$estimate_value)/denominator*100), .data$estimate_value)) |>
@@ -267,8 +271,7 @@ createSummarisedResultObservationPeriod <- function(result, observationPeriod, n
       "result_type" = "summarise_in_observation",
       "package_name" = "OmopSketch",
       "package_version" = as.character(utils::packageVersion("OmopSketch")),
-      "interval" = .env$interval,
-      "unitInterval" = .env$unitInterval
+      "interval" = .env$original_interval
     ))
 
   return(result)
@@ -332,9 +335,10 @@ addSexOverall <- function(result, sex){
   if(sex){
     result <- result |> rbind(
       result |>
-        dplyr::group_by(.data$age_group, .data$variable_level, .data$variable_name) |>
+        dplyr::group_by(.data$age_group, .data$additional_level, .data$variable_name) |>
         dplyr::summarise(estimate_value = sum(.data$estimate_value, na.rm = TRUE), .groups = "drop") |>
-        dplyr::mutate(sex = "overall")
+        dplyr::mutate(sex = "overall",
+                      additional_name = dplyr::if_else(additional_level == "overall", "overall", "time_interval"))
     )
   }
   return(result)

diff --git a/R/summariseRecordCount.R b/R/summariseRecordCount.R
@@ -37,6 +37,7 @@ summariseRecordCount <- function(cdm,
   # Initial checks ----
   omopgenerics::validateCdmArgument(cdm)
   omopgenerics::assertCharacter(omopTableName)
+  original_interval <- interval
   x <- validateIntervals(interval)
   interval <- x$interval
   unitInterval <- x$unitInterval
@@ -54,6 +55,7 @@ summariseRecordCount <- function(cdm,
                                                       cdm = cdm,
                                                       interval = interval,
                                                       unitInterval = unitInterval,
+                                                      original_interval,
                                                       ageGroup = ageGroup,
                                                       sex = sex)
                        }
@@ -65,7 +67,7 @@ summariseRecordCount <- function(cdm,
 
 #' @noRd
 summariseRecordCountInternal <- function(omopTableName, cdm, interval, unitInterval,
-                                         ageGroup, sex) {
+                                         original_interval, ageGroup, sex) {
 
   prefix <- omopgenerics::tmpPrefix()
   omopTable <- cdm[[omopTableName]] |> dplyr::ungroup()
@@ -107,7 +109,7 @@ summariseRecordCountInternal <- function(omopTableName, cdm, interval, unitInter
   }
 
   # Create summarised result ----
-  result <- createSummarisedResultRecordCount(result, strata, omopTable, omopTableName, interval, unitInterval)
+  result <- createSummarisedResultRecordCount(result, strata, omopTable, omopTableName, original_interval)
   omopgenerics::dropTable(cdm = cdm, name = dplyr::starts_with(prefix))
 
   return(result)
@@ -230,12 +232,11 @@ splitIncidenceBetweenIntervals <- function(cdm, omopTable, date, prefix){
     dplyr::select(-c("interval_start_date", "interval_end_date", "incidence_date"))
 }
 
-createSummarisedResultRecordCount <- function(result, strata, omopTable, omopTableName, interval, unitInterval){
+createSummarisedResultRecordCount <- function(result, strata, omopTable, omopTableName, original_interval){
 
   result <- result |>
     dplyr::mutate(n = 1) |>
     dplyr::select(-"person_id") |>
-    # dplyr::collect() |> # https://github.com/darwin-eu-dev/PatientProfiles/issues/706
     PatientProfiles::summariseResult(
       variables = "n",
       strata = strata,
@@ -246,18 +247,15 @@ createSummarisedResultRecordCount <- function(result, strata, omopTable, omopTab
     suppressMessages() |>
     dplyr::mutate("variable_name" = stringr::str_to_sentence(.data$variable_name)) |>
     dplyr::mutate(
-      "result_id" = as.integer(1),
-      "cdm_name" = omopgenerics::cdmName(omopgenerics::cdmReference(omopTable)),
       "group_name"  = "omop_table",
-      "group_level" = omopTableName,
-      "additional_name" = "overall",
-      "additional_level" = "overall"
+      "group_level" = omopTableName
     )
 
-  if(interval != "overall"){
+  if(original_interval != "overall"){
     result <- result |>
       visOmopResults::splitStrata() |>
-      dplyr::mutate(variable_level = .data$interval_group) |>
+      dplyr::mutate(additional_level = .data$interval_group) |>
+      dplyr::mutate(additional_name = dplyr::if_else(additional_level == "overall", "overall", "time_interval")) |>
       visOmopResults::uniteStrata(unique(unlist(strata))[unique(unlist(strata)) != "interval_group"]) |>
       dplyr::select(-"interval_group")
   }
@@ -268,7 +266,8 @@ createSummarisedResultRecordCount <- function(result, strata, omopTable, omopTab
         "result_id" = 1L,
         "result_type" = "summarise_record_count",
         "package_name" = "OmopSketch",
-        "package_version" = as.character(utils::packageVersion("OmopSketch"))
+        "package_version" = as.character(utils::packageVersion("OmopSketch")),
+        "interval" = .env$original_interval
       )
     )
 }
diff --git a/R/utilities.R b/R/utilities.R
@@ -1,18 +1,23 @@
 startDate <- function(name) {
   tables$start_date[tables$table_name == name]
 }
+
 endDate <- function(name) {
   tables$end_date[tables$table_name == name]
 }
+
 standardConcept <- function(name) {
   tables$standard_concept[tables$table_name == name]
 }
+
 sourceConcept <- function(name) {
   tables$source_concept[tables$table_name == name]
 }
+
 typeConcept <- function(name) {
   tables$type_concept[tables$table_name == name]
 }
+
 tableId <- function(name) {
   tables$id[tables$table_name == name]
 }
@@ -21,7 +26,7 @@ warnFacetColour <- function(result, cols) {
   colsToWarn <- result |>
     dplyr::select(
       "cdm_name", "group_name", "group_level", "strata_name", "strata_level",
-      "variable_name", "variable_level", "additional_name", "additional_level"
+      "variable_name", "variable_level"
     ) |>
     dplyr::distinct() |>
     visOmopResults::splitAll() |>
@@ -36,12 +41,14 @@ warnFacetColour <- function(result, cols) {
   }
   invisible(NULL)
 }
+
 collapseStr <- function(x, sep) {
   x <- x[x != ""]
   if (length(x) == 1) return(x)
   len <- length(x)
   paste0(paste0(x[-len], collapse = ", "), " ", sep, " ", x[len])
 }
+
 asCharacterFacet <- function(facet) {
   if (rlang::is_formula(facet)) {
     facet <- as.character(facet)

diff --git a/tests/testthat/test-summariseConceptCounts.R b/tests/testthat/test-summariseConceptCounts.R
@@ -1,6 +1,6 @@
 test_that("summarise code use - eunomia", {
   skip_on_cran()
-  cdm <- cdmEunomia()
+ cdm <- cdmEunomia()
   acetiminophen <- c(1125315,  1127433, 40229134,
                      40231925, 40162522, 19133768,  1127078)
   poliovirus_vaccine <- c(40213160)