Updated plot for SCCS time trends

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
   )
 }

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 %>%

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."
+            "The ratio of observed to expected outcomes per month. The expected count is computing either assuming a constant rate (bottom plot) or adjusting for calendar time, seasonality, and / or age, as specified in the model (top plot)."
           )
         ),
         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)
+          }
         }
       })
 

tests/testthat/test-helpers-sccsPlots.R

@@ -6,7 +6,8 @@ test_that("convert to dates", {
   testthat::expect_equal(as.character(convertToEndDate(2020,12)), "2020-12-31")
 })
 
-test_that("plotTimeTrend", {
+# Note - this is the old plot
+test_that("plotTimeTrendStability", {
   df <- data.frame(
     calendarYear = c(2011,2012),
     calendarMonth = c(1,1),
@@ -15,11 +16,24 @@ test_that("plotTimeTrend", {
     adjustedRate = runif(2),
     stable = rep(1,2)
   )
+  res <- plotTimeTrendStability(df)
+  testthat::expect_is(res, "ggplot")
+})
+# New plot
+test_that("plotTimeTrend", {
+  df <- data.frame(
+    calendarYear = c(2011,2012),
+    calendarMonth = c(1,1),
+    ratio = runif(2),
+    observedSubjects = rep(100,2),
+    adjustedRatio = runif(2)
+  )
   res <- plotTimeTrend(df)
   testthat::expect_is(res, "ggplot")
 })
 
 
+
 test_that("plotTimeToEventSccs", {
 
   df <- data.frame(