From 03d4a9fff54059af7308c231ef5f3e32a40d7cb1 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Thu, 21 Sep 2023 13:59:02 -0700 Subject: [PATCH 1/3] Updated plot for SCCS time trends --- R/helpers-sccsDataPulls.R | 1 - R/helpers-sccsPlots.R | 50 ++++++++++++++++++++++++++++++++++++++- R/sccs-results-full.R | 9 +++++-- 3 files changed, 56 insertions(+), 4 deletions(-) diff --git a/R/helpers-sccsDataPulls.R b/R/helpers-sccsDataPulls.R index d2b7e928..ee3ac178 100644 --- 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 index e8308c36..c3d0fe4f 100644 --- 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 index 98281c55..009a247d 100644 --- 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) + } } }) From bba449ff350901f324b49f70bd3f1330acd54296 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Tue, 26 Sep 2023 11:47:20 -0700 Subject: [PATCH 2/3] updated figure text --- R/sccs-results-full.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/sccs-results-full.R b/R/sccs-results-full.R index 009a247d..f2774fbe 100644 --- 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 ratio people with the outcome adjusted or unadjusted for age, season, and calendar time if specified in the model." + "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( From 20bbac3919c8705278ff87e1741ee426434fff8f Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Tue, 26 Sep 2023 12:12:45 -0700 Subject: [PATCH 3/3] fix test for old data and add new test --- tests/testthat/test-helpers-sccsPlots.R | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-helpers-sccsPlots.R b/tests/testthat/test-helpers-sccsPlots.R index 71651df7..391a613a 100644 --- a/tests/testthat/test-helpers-sccsPlots.R +++ b/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(