Merge pull request #148 from The-Strategy-Unit/fix-download-issue-145

Fix download issue 145

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mhSurgeModelling
 Title: Mental Health Covid-19 Surge Modelling
-Version: 1.0.1
+Version: 1.0.2
 Authors@R: c(
  person('Tom', 'Jemmett', email = '[email protected]', role = c('cre', 'aut')),
  person('Victor', 'Yu', email = '[email protected]', role = 'aut'),

R/module_results.R

@@ -27,16 +27,20 @@ results_ui <- function(id) {
  c("Selected Service" = "selected", "All Services" = "all"),
  inline = TRUE
  ),
- downloadButton(
- NS(id, "download_report"),
- "Download report (.pdf)"
- ),
+ disabled({
+ downloadButton(
+ NS(id, "download_report"),
+ "Download report (.pdf)"
+ )
+ }),
  tags$br(),
  tags$br(),
- downloadButton(
- NS(id, "download_output"),
- "Download model output (.csv)"
- )
+ disabled({
+ downloadButton(
+ NS(id, "download_output"),
+ "Download model output (.csv)"
+ )
+ })
  )
 
  results_value_boxes <- primary_box(
@@ -132,6 +136,24 @@ results_server <- function(id, params, model_output) {
  "model_output must be a reactive" = is.reactive(model_output))
 
  moduleServer(id, function(input, output, session) {
+ # disable buttons whenever the state is changes
+ observeEvent(model_output(), {
+ shinyjs::disable("download_report")
+ shinyjs::disable("download_output")
+
+ model_output()
+ }, priority = 100)
+
+ # renable the buttons only if state is valid
+ observeEvent(model_output(), {
+ req(input$services)
+ req(input$download_choice)
+ o <- req(model_output())
+ req(nrow(o) > 0)
+
+ shinyjs::enable("download_report")
+ shinyjs::enable("download_output")
+ }, priority = -100)
 
  output$download_report <- downloadHandler(
  filename = function() {
@@ -141,18 +163,19 @@ results_server <- function(id, params, model_output) {
  if (input$download_choice == "all") {
  "AllServices"
  } else {
- gsub(" ", "", input$services, fixed = TRUE)
+ gsub(" ", "", req(input$services), fixed = TRUE)
  },
  ".pdf"
  )
  },
  content = function(file) {
  model_output <- model_output()
+
  params <- reactiveValuesToList(params)
  services <- if (input$download_choice == "all") {
  names(params$treatments)
  } else {
- input$services
+ req(input$services)
  }
 
  rmarkdown::render(
@@ -188,19 +211,23 @@ results_server <- function(id, params, model_output) {
  })
 
  output$referrals_plot <- renderPlotly({
- referrals_plot(model_output(), input$services)
+ services <- req(input$services)
+ referrals_plot(model_output(), services)
  })
 
  output$demand_plot <- renderPlotly({
- demand_plot(model_output(), appointments(), input$services)
+ services <- req(input$services)
+ demand_plot(model_output(), appointments(), services)
  })
 
  output$graph <- renderPlotly({
- create_graph(model_output(), treatments = input$services)
+ services <- req(input$services)
+ create_graph(model_output(), treatments = services)
  })
 
  output$combined_plot <- renderPlotly({
- combined_plot(model_output(), input$services, reactiveValuesToList(params))
+ services <- req(input$services)
+ combined_plot(model_output(), services, reactiveValuesToList(params))
  })
 
  # Output boxes
@@ -213,20 +240,24 @@ results_server <- function(id, params, model_output) {
  ) %>%
  pmap(function(output_id, value_type, text) {
  output[[output_id]] <- renderValueBox({
+ services <- req(input$services)
  value <- model_output() %>%
- model_totals(value_type, input$services)
+ model_totals(value_type, services)
  valueBox(value, text)
  })
  })
 
  pcnt_surgedemand_denominator <- reactive({
- params$demand[[input$services]] %>%
+ services <- req(input$services)
+
+ params$demand[[services]] %>%
  filter(.data$month < min(.data$month) %m+% months(12)) %>%
  pull("underlying") %>%
  sum()
  })
 
  output$pcnt_surgedemand <- renderValueBox({
+ services <- req(input$services)
  denominator <- pcnt_surgedemand_denominator()
 
  value <- if (denominator == 0) {
@@ -235,7 +266,7 @@ results_server <- function(id, params, model_output) {
  numerator <- model_output() %>%
  filter(day(.data$date) == 1,
  .data$type == "new-referral",
- .data$treatment == input$services) %>%
+ .data$treatment == services) %>%
  pull(.data$value) %>%
  sum()
 
@@ -245,6 +276,8 @@ results_server <- function(id, params, model_output) {
  })
 
  output$pct_surgedemand_table <- renderTable({
+ services <- req(input$services)
+
  date_to_n_months <- function(d) {
  as.integer(year(d) * 12L + month(d))
  }
@@ -256,7 +289,7 @@ results_server <- function(id, params, model_output) {
  model_output() %>%
  filter(day(.data$date) == 1,
  .data$type == "new-referral",
- .data$treatment == input$services) %>%
+ .data$treatment == services) %>%
  mutate(d1 = date_to_n_months(.data$date),
  d2 = date_to_n_months(min(.data$date))) %>%
  group_by(Year = paste("Y", (.data$d1 - .data$d2) %/% 12L + 1)) %>%
@@ -273,7 +306,8 @@ results_server <- function(id, params, model_output) {
  })
 
  output$results_popgroups <- renderPlotly({
- popgroups_plot(model_output(), input$services)
+ services <- req(input$services)
+ popgroups_plot(model_output(), services)
  })
 
  help_popups("results") %>%

tests/testthat/test-module_results.R

@@ -40,7 +40,8 @@ test_that("it set's up download handlers correctly", {
  stub(results_server, "tempdir", "tempdir/")
 
  testServer(results_server, args = results_server_args(), {
- session$setInputs(download_choice = "all")
+ session$setInputs(download_choice = "all",
+ services = "service")
 
  expect_equal(as.character(output$download_report$html), "download_report")
  expect_equal(as.character(output$download_output$html), "download_output")
@@ -131,6 +132,7 @@ test_that("plots are created correctly", {
  m <- mock()
 
  stub(results_server, "renderPlotly", m)
+ stub(results_server, "req", identity)
  stub(results_server, "referrals_plot", "referrals_plot")
  stub(results_server, "demand_plot", "demand_plot")
  stub(results_server, "create_graph", "create_graph")
@@ -139,7 +141,6 @@ test_that("plots are created correctly", {
 
  testServer(results_server, args = results_server_args(), {
  session$setInputs(services = "IAPT")
-
  expect_called(m, 5)
  expect_args(m, 1, "referrals_plot")
  expect_args(m, 2, "demand_plot")
@@ -157,7 +158,7 @@ test_that("referrals_plot is called correctly", {
  session$setInputs(services = "IAPT")
 
  expect_called(m, 1)
- expect_call(m, 1, referrals_plot(model_output(), input$services))
+ expect_call(m, 1, referrals_plot(model_output(), services))
  })
 })
 
@@ -169,7 +170,7 @@ test_that("demand_plot is called correctly", {
  session$setInputs(services = "IAPT")
 
  expect_called(m, 1)
- expect_call(m, 1, demand_plot(model_output(), appointments(), input$services))
+ expect_call(m, 1, demand_plot(model_output(), appointments(), services))
  })
 })
 
@@ -181,7 +182,7 @@ test_that("create_graph is called correctly", {
  session$setInputs(services = "IAPT")
 
  expect_called(m, 1)
- expect_call(m, 1, create_graph(model_output(), treatments = input$services))
+ expect_call(m, 1, create_graph(model_output(), treatments = services))
  })
 })
 
@@ -193,7 +194,7 @@ test_that("popgroups_plot is called correctly", {
  session$setInputs(services = "IAPT")
 
  expect_called(m, 1)
- expect_call(m, 1, popgroups_plot(model_output(), input$services))
+ expect_call(m, 1, popgroups_plot(model_output(), services))
  })
 })