SummariseTableCounts()

DESCRIPTION

@@ -22,12 +22,16 @@ Imports:
     cli,
     CohortCharacteristics,
     dplyr,
+    ggplot2,
+    glue,
+    gt,
     IncidencePrevalence (>= 0.7.0),
     lubridate,
     magrittr,
     omopgenerics (>= 0.0.3),
     PatientProfiles,
     rlang,
+    tibble,
     tidyr,
     visOmopResults
 Depends: 

NAMESPACE

@@ -1,10 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
+export(plotTableCounts)
 export(summariseEntryCharacteristics)
 export(summariseOmopTable)
 export(summarisePersonDays)
+export(summariseTableCounts)
 export(suppress)
+export(tableOmopTable)
 importFrom(magrittr,"%>%")
 importFrom(omopgenerics,suppress)
+importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,.env)

R/plotTableCounts.R

@@ -0,0 +1,34 @@
+#' Create a gt table from a summarised omop_table.
+#'
+#' @param summarisedTableCounts A summarised_result object with the output from summariseTableCounts().
+#'
+#' @return A ggplot showing the table counts
+#'
+#' @export
+#'
+plotTableCounts <- function(summarisedTableCounts) {
+  # Initial checks ----
+  assertClass(summarisedTableCounts, "summarised_result")
+
+  if(summarisedTableCounts |> dplyr::tally() |> dplyr::pull("n") == 0){
+    cli::cli_warn("summarisedOmopTable is empty.")
+    return(
+      summarisedTableCounts |>
+        ggplot2::ggplot()
+    )
+  }
+
+  # Plot ----
+  summarisedTableCounts |>
+    dplyr::mutate(count = as.numeric(.data$estimate_value),
+                  time = .data$strata_level) |>
+    visOmopResults::splitGroup() |>
+    ggplot2::ggplot(ggplot2::aes(x = .data$time, y = .data$count, group = .data$omop_table, color = .data$omop_table)) +
+    ggplot2::geom_point() +
+    ggplot2::geom_line() +
+    ggplot2::facet_wrap(facets = "cdm_name") +
+    ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1)) +
+    ggplot2::xlab("Time") +
+    ggplot2::ylab("Counts") +
+    ggplot2::labs(color = "Omop table")
+}

R/summariseOmopTable.R

@@ -10,7 +10,7 @@
 #' @param inObservation Whether to include the percentage of records in
 #' observation.
 #' @param standardConcept Whether to summarise standard concept.
-#' @param sourceVocabulary Whether to summarise source concept.
+#' @param sourceVocabulary Whether to summarise source vocabulary.
 #' @param domainId Whether to summarise domain id of standard concept id.
 #' @param typeConcept Whether to summarise type concept id field.
 #'
@@ -48,15 +48,21 @@ summariseOmopTable <- function(omopTable,
 
   if ("observation_period" == omopgenerics::tableName(omopTable)) {
     if(standardConcept){
-      cli::cli_warn("standardConcept turned to FALSE, as omopTable provided is observation_period")
+      if(!missing(standardConcept)){
+        cli::cli_warn("standardConcept turned to FALSE, as omopTable provided is observation_period")
+      }
       standardConcept <- FALSE
     }
     if(sourceVocabulary){
-      cli::cli_warn("sourceVocabulary turned to FALSE, as omopTable provided is observation_period")
+      if(!missing(sourceVocabulary)){
+        cli::cli_warn("sourceVocabulary turned to FALSE, as omopTable provided is observation_period")
+      }
       sourceVocabulary <- FALSE
     }
     if(domainId){
-      cli::cli_warn("domainId turned to FALSE, as omopTable provided is observation_period")
+      if(!missing(domainId)){
+        cli::cli_warn("domainId turned to FALSE, as omopTable provided is observation_period")
+      }
       domainId <- FALSE
     }
   }
@@ -68,7 +74,8 @@ summariseOmopTable <- function(omopTable,
   result <- omopgenerics::emptySummarisedResult()
 
   if(omopTable |> dplyr::tally() |> dplyr::pull("n") == 0){
-    cli::cli_abort(paste0(omopgenerics::tableName(omopTable), " omop table is empty."))
+    cli::cli_warn(paste0(omopgenerics::tableName(omopTable), " omop table is empty. Returning an empty summarised omop table."))
+    return(result)
   }
 
   # Counts summary ----
@@ -85,6 +92,12 @@ summariseOmopTable <- function(omopTable,
       addRecordsPerPerson(omopTable, recordsPerPerson, cdm)
   }
 
+  denominator <- result |>
+    dplyr::filter(.data$variable_name == "number_records") |>
+    dplyr::pull("estimate_value") |>
+    as.integer()
+
+
   # Summary concepts ----
   if (inObservation | standardConcept | sourceVocabulary | domainId | typeConcept) {
     cli::cli_inform(c("i" = "Summarising concepts"))
@@ -93,13 +106,8 @@ summariseOmopTable <- function(omopTable,
       inObservation, standardConcept, sourceVocabulary, domainId, typeConcept
     )
 
-    denominator <- result |>
-      dplyr::filter(.data$variable_name == "number_records") |>
-      dplyr::pull("estimate_value") |>
-      as.integer()
-
     result <- result |>
-      dplyr::full_join(
+      dplyr::bind_rows(
         omopTable |>
           addVariables(variables) |>
           dplyr::group_by(dplyr::across(dplyr::all_of(variables))) |>
@@ -112,11 +120,14 @@ summariseOmopTable <- function(omopTable,
 
   # Format output as a summarised result
   result <- result |>
+    dplyr::mutate(variable_name = dplyr::if_else(.data$variable_name == "number_records", "Number of records", .data$variable_name),
+                  variable_name = dplyr::if_else(.data$variable_name == "number_subjects", "Number of subjects", .data$variable_name),
+                  variable_name = dplyr::if_else(.data$variable_name == "records_per_person", "Records per person", .data$variable_name)) |>
     dplyr::mutate(
       "result_id" = 1L,
       "cdm_name" = omopgenerics::cdmName(cdm),
-      "group_name" = "overall",
-      "group_level" = "overall",
+      "group_name" = "omop_table",
+      "group_level" = omopgenerics::tableName(omopTable),
       "strata_name" = "overall",
       "strata_level" = "overall",
       "additional_name" = "overall",
@@ -129,14 +140,16 @@ summariseOmopTable <- function(omopTable,
       "package_version" = as.character(utils::packageVersion("OmopSketch"))
     ))
 
-  return(result)
+return(result)
 }
 
 # Functions -----
 getNumberPeopleInCdm <- function(cdm){
   cdm[["person"]] |>
-    dplyr::pull("person_id") |>
-    dplyr::n_distinct()
+    dplyr::ungroup() |>
+    dplyr::summarise(x = dplyr::n_distinct(.data$person_id)) |>
+    dplyr::pull("x") |>
+    as.integer()
 }
 
 addNumberSubjects <- function(result, omopTable){
@@ -145,7 +158,12 @@ addNumberSubjects <- function(result, omopTable){
       "variable_name"  = "number_subjects",
       "estimate_name"  = "count",
       "estimate_type"  = "integer",
-      "estimate_value" = as.character(omopTable |> dplyr::pull(.data$person_id) |> dplyr::n_distinct())
+      "estimate_value" = as.character(
+        omopTable |>
+          dplyr::summarise(x = dplyr::n_distinct(.data$person_id)) |>
+          dplyr::pull("x") |>
+          as.integer()
+      )
     )
 }
 addNumberRecords  <- function(result, omopTable){
@@ -154,25 +172,29 @@ addNumberRecords  <- function(result, omopTable){
       "variable_name"  = "number_records",
       "estimate_name"  = "count",
       "estimate_type"  = "integer",
-      "estimate_value" = as.character(omopTable |> dplyr::tally() |> dplyr::pull(.data$n))
+      "estimate_value" = as.character(omopTable |> dplyr::tally() |> dplyr::pull("n"))
     )
 }
+
 addSubjectsPercentage <- function(result, omopTable, people){
   result |>
     dplyr::add_row(
-      "variable_name"  = "subjects_percentage",
+      "variable_name"  = "number_subjects",
       "estimate_name"  = "percentage",
       "estimate_type"  = "percentage",
       "estimate_value" = as.character(
-        100* (omopTable |> dplyr::pull(.data$person_id) |> dplyr::n_distinct()) / .env$people
+        100* (omopTable |>
+                dplyr::summarise(x = dplyr::n_distinct(.data$person_id)) |>
+                dplyr::pull("x") |>
+                as.integer()) / .env$people
       )
     )
 }
 
 addRecordsPerPerson <- function(result, omopTable, recordsPerPerson, cdm){
   suppressMessages(
     result |>
-      dplyr::union_all(
+      dplyr::bind_rows(
         cdm[["person"]] |>
           dplyr::select("person_id") |>
           dplyr::left_join(