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..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 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) + } } }) 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(