Updated plot for SCCS time trends

OHDSI · Sep 21, 2023 · 03d4a9f · 03d4a9f
1 parent a1f36db
commit 03d4a9f
Show file tree

Hide file tree

Showing 3 changed files with 56 additions and 4 deletions.
diff --git a/R/helpers-sccsDataPulls.R b/R/helpers-sccsDataPulls.R
@@ -205,7 +205,6 @@ getSccsTimeTrend <- function(connectionHandler,
     database_id = databaseId,
     analysis_id = analysisId,
     outcome_id = outcomeId,
-    #exposure_id = exposureId,
     snakeCaseToCamelCase = TRUE
   )
 }

diff --git a/R/helpers-sccsPlots.R b/R/helpers-sccsPlots.R
@@ -18,7 +18,7 @@ convertToEndDate <- function(year, month) {
   )) - 1)
 }
 
-plotTimeTrend <- function(timeTrend) {
+plotTimeTrendStability <- function(timeTrend) {
 
   timeTrend <- timeTrend %>%
     dplyr::mutate(
@@ -71,6 +71,54 @@ plotTimeTrend <- function(timeTrend) {
   return(plot)
 }
 
+plotTimeTrend <- function(timeTrend) {
+
+  timeTrend <- timeTrend %>%
+    dplyr::mutate(
+      monthStartDate = convertToStartDate(.data$calendarYear, .data$calendarMonth),
+      monthEndDate = convertToEndDate(.data$calendarYear, .data$calendarMonth),
+      ratio = pmax(0, .data$ratio),
+      adjustedRatio = pmax(0, .data$adjustedRatio))
+
+  plotData <- dplyr::bind_rows(
+    dplyr::select(timeTrend, "monthStartDate", "monthEndDate", value = "ratio") %>%
+      dplyr::mutate(type = "Assuming constant rate"),
+    dplyr::select(timeTrend, "monthStartDate", "monthEndDate", value = "adjustedRatio") %>%
+      dplyr::mutate(type = "Adj. For cal. time and season")
+  )
+
+  levels <- c("Assuming constant rate", "Adj. For cal. time and season")
+  plotData$type <- factor(plotData$type, levels = rev(levels))
+
+  theme <- ggplot2::element_text(colour = "#000000", size = 14)
+  themeRA <- ggplot2::element_text(colour = "#000000", size = 14, hjust = 1)
+  plot <- ggplot2::ggplot(plotData, ggplot2::aes(xmin = .data$monthStartDate, xmax = .data$monthEndDate + 1)) +
+    ggplot2::geom_rect(ggplot2::aes(ymax = .data$value),
+                       ymin = 0,
+                       fill = grDevices::rgb(0, 0, 0.8, alpha = 0.6),
+                       alpha = 0.6,
+                       linewidth = 0) +
+    ggplot2::scale_x_date("Calendar time") +
+    ggplot2::scale_y_continuous("Observed / expected", limits = c(0, NA)) +
+    ggplot2::facet_grid(.data$type ~ ., scales = "free_y") +
+    ggplot2::theme(
+      panel.grid.minor = ggplot2::element_blank(),
+      panel.background = ggplot2::element_rect(fill = "#FAFAFA", colour = NA),
+      panel.grid.major = ggplot2::element_line(colour = "#AAAAAA"),
+      axis.ticks = ggplot2::element_blank(),
+      axis.text.y = themeRA,
+      axis.text.x = theme,
+      axis.title = theme,
+      strip.text.y = theme,
+      strip.background = ggplot2::element_blank(),
+      legend.title = ggplot2::element_blank(),
+      legend.position = "top",
+      legend.text = theme
+    )
+  return(plot)
+}
+
+
 plotTimeToEventSccs <- function(timeToEvent) {
 
   events <- timeToEvent %>%

diff --git a/R/sccs-results-full.R b/R/sccs-results-full.R
@@ -65,7 +65,7 @@ sccsFullResultViewer <- function(id) {
           shiny::plotOutput(ns("timeTrendPlot"), height = 600),
           shiny::div(
             shiny::strong("Figure 4."),
-            "Per calendar month the number of people observed, the unadjusted rate of the outcome, and the rate of the outcome after adjusting for age, season, and calendar time, if specified in the model. Red indicates months where the adjusted rate was significantly different from the mean adjusted rate."
+            "Per calendar month the ratio people with the outcome adjusted or unadjusted for age, season, and calendar time if specified in the model."
           )
         ),
         shiny::tabPanel(
@@ -224,7 +224,12 @@ sccsFullResultServer <- function(
             databaseId = row$databaseId,
             analysisId = row$analysisId
           )
-          plotTimeTrend(timeTrend)
+
+          if (all(c(hasData(timeTrend$ratio), hasData(timeTrend$adjustedRatio)))) {
+            plotTimeTrend(timeTrend)
+          } else {
+            plotTimeTrendStability(timeTrend)
+          }
         }
       })