Reactive Shiny Application

Question

I am trying to create an interactive shiny application that displays a leaflet plot based on a user's date and plot type specification. Ideally, I would like the user to specify whether they would like to view a state-wide or a county-wide plot. Then, based on their answers, I would like them to decide whether to use the regular data or the standardized data. After this, they would hit a submit button and the plot would render. I don't want the plot to render until the user presses the "Submit" action button. This is my idea so far, but it fails whenever I try to implement.

library(ggplot2)
library(shapefiles)
library(sp)
library(CARBayes)
library(leaflet)
library(rgdal)
library(leaflet)
library(shiny)

## County Data
dta <- read.csv()

## County Data (percentage)
perc <-read.csv()

## Date Specification Function
selectdates <- function(data, start, end){
    keep <- data[, 1:5]
    data <- data[, -c(1:5)]
    tmp1 <- as.Date(names(data))
    tmp2 <- which(tmp1 >= as.Date(start) & tmp1 <= as.Date(end))
    tmp <- data[, tmp2]
    Sum <- rowSums(tmp)
    tmp <- cbind(keep, Sum)
    return(tmp)
}


# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Application title
    titlePanel("Mapping"),
    tags$em(""),
    tags$hr(),
    
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            dateRangeInput("daterange", "Date Range:",
                           start = as.character(Sys.Date() - 6),
                           end = as.character(Sys.Date())),
            selectInput("ptChoice", "Type of Plot:", choices = c("", "County-Wise", "State-Wise")),
            selectInput("typeChoice", "Data Type:", choices = c("", "Raw", "Percentage")),
            actionButton("submitButton", "Submit", class = "btn btn-primary")
        ),
        
        # Display leaflet plot of cases
        mainPanel(
            leafletOutput("countyPlot"),
            leafletOutput("statePlot")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    observeEvent(input$ptChoice, {
        req(input$ptchoice)
        if(input$ptChoice == "County-Wide"){
            hide("statePlot")
            show("countyPlot")
        }
        else{
            hide("countyPlot")
            show("statePlot")
        }
    })
    
    fdta <- eventReactive(input$typeChoice, {
        if (input$typeChoice == "Raw"){
            df <- selectdates(data = tmp, start = input$daterange[1], end = input$daterange[2])
            row.names(df) <- df$FIPS
        }else if (input$typeChoice == "Percentage"){
            df <- selectdates(data = perc, start = input$daterange[1], end = input$daterange[2])
        }else {return(NULL)}
        df
    })
    
    observeEvent(input$submitButton, {
        output$statePlot <- renderLeaflet({
            ## INSERT STATE PLOT CODE HERE
        })
        output$countyPlot <- renderLeaflet({

            ## Loads SHP and DBF File
            shp <- read.shp()
            dbf <- read.dbf()
            
            sp <- combine.data.shapefile(data = fdta, shp = shp, dbf = dbf)
            proj4string(sp) <- CRS("+proj=longlat +datum=WGS84 +no_defs")
            sp <- spTransform(sp, CRS("+proj=longlat +datum=WGS84 +no_defs"))
            
            colours <- colorNumeric(palette = "YlOrRd", domain = sp@data$Sum)
            
            leaflet(sp) %>%
                addTiles() %>%
                addPolygons(
                    fillColor = ~ colours(Sum),
                    weight = 1,
                    opacity = 0.7,
                    color = "white",
                    dashArray = '3',
                    fillOpacity = 0.7,
                    highlight = highlightOptions(
                        weight = 5,
                        color = "#666",
                        dashArray = "",
                        fillOpacity = 0.7,
                        bringToFront = TRUE
                    )
                ) %>%
                addLegend(
                    pal = colours,
                    values = sp@data$Sum,
                    opacity = 1,
                    title = "Count"
                ) %>%
                addScaleBar(position = "bottomleft")
        })
    })

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

You can put the two plots inside an observeEvent, if you want it only after someone clicks on submit button. To use the appropriate dataframe, create a reactive dataframe and then use it as dfa() to generate the appropriate plot. Try this

server = function(input, output) {

    observeEvent(input$ptChoice,{
      req(input$ptChoice)
      if(input$ptChoice == "County-Wide"){
        hide("statePlot")
        show("countyPlot")
      }else{
        hide("countyPlot")
        show("statePlot")
      }
    })
    
    dfa <- eventReactive(input$typechoice, {
      if (input$typechoice == "Regular") {
        df <- dta
      }else if (input$typechoice == "Standardized") {
        df <- dta2
      }else {return(NULL)}
      df
    })

    observeEvent(input$submitButton,{
      output$stateplot <- renderLeaflet({
        state <- CODE FOR STATE PLOT
      })
      output$countyPlot <- renderLeaflet({
        county <- CODE FOR COUNTY PLOT
      })
    })

  }

Answer 2

You might want to have your leaflet plot be stored in reactiveValues (rv) - then, you can have one output for your plot, and show what is stored in rv.

To change the plot when the submit button is pressed, be sure to reference the input$submitButton with your observeEvent.

Here is a working example that can be adapted. You could use an additional function to generate the plots based on your input values.

library(ggplot2)
library(leaflet)
library(shiny)

ui = fluidPage(
  titlePanel("Leaflet Plot"),
  tags$em(""),
  tags$hr(),
  sidebarLayout(
    sidebarPanel(
      selectInput("plotChoice", "Type of Plot:", choices = c("", "Boston", "Chicago")),
      actionButton("submitButton", "Submit", class = "btn btn-primary")
    ),
    # Display leaflet plot of cases
    mainPanel(
      leafletOutput("leafletPlot")
    )
  )
)


server = function(input, output) {
  
  rv <- reactiveValues(plot = NULL)
  
  output$leafletPlot <- renderLeaflet({
    rv$plot
  })
  
  observeEvent(input$submitButton, {
    if (input$plotChoice == "Boston") {
      rv$plot <- leaflet() %>% setView(lng = -71.0589, lat = 42.3601, zoom = 12) %>% addTiles()
    } else {
      rv$plot <- leaflet() %>% setView(lng = -87.6298, lat = 41.8781, zoom = 12) %>% addTiles()
    }
  })
  
}

shinyApp(ui = ui, server = server)