From 0b06d81c4b56bb2688f9c1dc0fe3b0ef4235d45d Mon Sep 17 00:00:00 2001 From: Kate Harwood Date: Tue, 6 Apr 2021 14:54:20 -0400 Subject: [PATCH 1/3] add shuffle colors button --- dashboard/app.R | 28 ++++++++++++++++++++++------ dashboard/www/style.css | 5 +++++ 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/dashboard/app.R b/dashboard/app.R index b4b57e7..17e2d51 100644 --- a/dashboard/app.R +++ b/dashboard/app.R @@ -138,6 +138,10 @@ ui <- fluidPage(padding=0, tabPanel("Evaluation Plots", value = "evaluations", fluidRow(column(11, textOutput('renderWarningText'))), plotlyOutput(outputId = "summaryPlot", height="auto"), + fluidRow( + column(11, offset=1, + div(id="refresh-colors", actionButton(inputId="refreshColors", label= "Shuffle Colors")) + )), tags$br(), plotlyOutput(outputId = "truthPlot", height="auto"), fluidRow( @@ -211,13 +215,12 @@ server <- function(input, output, session) { # TODO handle this kind of error better dfNationDeaths = subset(dfNationDeaths, select = -c(full_location_name)) dfNationCases = subset(dfNationCases, select = -c(full_location_name)) + df <- rbind(dfStateCases, dfStateDeaths, dfNationCases, dfNationDeaths) df <- df %>% rename("10" = cov_10, "20" = cov_20, "30" = cov_30, "40" = cov_40, "50" = cov_50, "60" = cov_60, "70" = cov_70, "80" = cov_80, "90" = cov_90, "95" = cov_95, "98" = cov_98) # Prepare color palette - set.seed(100) - forecaster_rand <- sample(unique(df$forecaster)) - color_palette = setNames(object = viridis(length(unique(df$forecaster))), nm = forecaster_rand) + colorSeed = 100 # Prepare input choices forecasterChoices = sort(unique(df$forecaster)) @@ -228,7 +231,7 @@ server <- function(input, output, session) { # CREATE MAIN PLOT ################## summaryPlot = function(scoreDf, targetVariable, scoreType, forecasters, - horizon, loc, allLocations, coverageInterval = NULL) { + horizon, loc, allLocations, coverageInterval = NULL, colorSeed) { signalFilter = CASE_FILTER if (targetVariable == "Deaths") { signalFilter = DEATH_FILTER @@ -331,6 +334,10 @@ server <- function(input, output, session) { filteredScoreDf$ahead = factor(filteredScoreDf$ahead, levels = c(1, 2, 3, 4), labels = c("Horizon: 1 Week", "Horizon: 2 Weeks", "Horizon: 3 Weeks", "Horizon: 4 Weeks")) + set.seed(colorSeed) + forecasterRand <- sample(unique(df$forecaster)) + colorPalette = setNames(object = viridis(length(unique(df$forecaster))), nm = forecasterRand) + p = ggplot( filteredScoreDf, aes(x = Week_End_Date, y = Score, color = Forecaster, shape = Forecaster) @@ -341,7 +348,7 @@ server <- function(input, output, session) { scale_x_date(date_labels = "%b %Y") + scale_y_continuous(limits = c(0,NA), labels = scales::comma) + facet_wrap(~ahead, ncol=1) + - scale_color_manual(values = color_palette) + + scale_color_manual(values = colorPalette) + theme_bw() + theme(panel.spacing=unit(0.5, "lines")) @@ -395,13 +402,22 @@ server <- function(input, output, session) { ############# output$summaryPlot <- renderPlotly({ summaryPlot(df, input$targetVariable, input$scoreType, input$forecasters, - input$aheads, input$location, input$allLocations, input$coverageInterval) + input$aheads, input$location, input$allLocations, input$coverageInterval, colorSeed) }) ################### # EVENT OBSERVATION ################### + observeEvent(input$refreshColors, { + colorSeed = floor(runif(1, 1, 1000)) + print(colorSeed) + output$summaryPlot <- renderPlotly({ + summaryPlot(df, input$targetVariable, input$scoreType, input$forecasters, + input$aheads, input$location, input$allLocations, input$coverageInterval, colorSeed) + }) + }) + # When the target variable changes, update available forecasters, locations, and CIs to choose from observeEvent(input$targetVariable, { if (input$targetVariable == 'Deaths') { diff --git a/dashboard/www/style.css b/dashboard/www/style.css index 9456afd..3bf49d7 100644 --- a/dashboard/www/style.css +++ b/dashboard/www/style.css @@ -51,4 +51,9 @@ } #drag-to-zoom { font-size:11px; +} +#refreshColors { + height: 26px; + margin-bottom:10px; + font-size: 12px; } \ No newline at end of file From 0176d8386f2852238ba2a5aab16e7826960fb147 Mon Sep 17 00:00:00 2001 From: Kate Harwood Date: Tue, 6 Apr 2021 15:39:16 -0400 Subject: [PATCH 2/3] get rid of extra space and print --- dashboard/app.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/dashboard/app.R b/dashboard/app.R index 17e2d51..8cacb04 100644 --- a/dashboard/app.R +++ b/dashboard/app.R @@ -215,7 +215,6 @@ server <- function(input, output, session) { # TODO handle this kind of error better dfNationDeaths = subset(dfNationDeaths, select = -c(full_location_name)) dfNationCases = subset(dfNationCases, select = -c(full_location_name)) - df <- rbind(dfStateCases, dfStateDeaths, dfNationCases, dfNationDeaths) df <- df %>% rename("10" = cov_10, "20" = cov_20, "30" = cov_30, "40" = cov_40, "50" = cov_50, "60" = cov_60, "70" = cov_70, "80" = cov_80, "90" = cov_90, "95" = cov_95, "98" = cov_98) @@ -411,7 +410,6 @@ server <- function(input, output, session) { observeEvent(input$refreshColors, { colorSeed = floor(runif(1, 1, 1000)) - print(colorSeed) output$summaryPlot <- renderPlotly({ summaryPlot(df, input$targetVariable, input$scoreType, input$forecasters, input$aheads, input$location, input$allLocations, input$coverageInterval, colorSeed) From da183ad93679e64ef0dfece42361a8eb5b4db70a Mon Sep 17 00:00:00 2001 From: Kate Harwood Date: Tue, 6 Apr 2021 15:41:44 -0400 Subject: [PATCH 3/3] remove extraneous margin --- dashboard/www/style.css | 1 - 1 file changed, 1 deletion(-) diff --git a/dashboard/www/style.css b/dashboard/www/style.css index 3bf49d7..b9b55e4 100644 --- a/dashboard/www/style.css +++ b/dashboard/www/style.css @@ -54,6 +54,5 @@ } #refreshColors { height: 26px; - margin-bottom:10px; font-size: 12px; } \ No newline at end of file