Isolate() function not working with reactive expression

I'm trying to isolate variables in my drop down menu so that the map doesn't update when a user changes the variable in the drop down menu, but instead changes when the action button is pressed. Currently, the only drop down menu not working as intended is the input$map.var, the other ones however are working properly. I'm a novice R coder so any help would be extremely appreciated! Thank you guys so much!
Here's some sample code:

ui <- navbarPage(title = span("Future Water Indiana",
style = "background-color: navy; color:white ; font-family: Calibri"),
tabPanel(span("Interactive map", style="color:olive; font-family: Calibri"),
fluidRow(
column(3,
# input: select variable to map
selectInput("map.var", span("Variable:", style="color:brown; font-family: Calibri"),
c( "Precipiation" = "_precip",
"Evapotranspiration" = "_et",
"Soil water content" = "_sw",
"Groundwater Recharge" = "_perc",
"Baseflow" = "_gw_q",
"Streamflow" = "_flow_out",
"Water Yield" = "_wyld"))
),
column(3,
# input: select time period
selectInput("map.stype", span("Summary Period:", style="color:brown; font-family: Calibri"),
c("Annual" = "ann",
"January" = 1,
"February" = 2,
"March" = 3,
"April" = 4,
"May" = 5,
"June" = 6,
"July" = 7,
"August" = 8,
"September" = 9,
"October" = 10,
"November" = 11,
"December" = 12))
),
column(3,
# input: select time period
selectInput("map.period", span("Time Period:", style="color:brown; font-family: Calibri"),
c("2020s" = "2020",
"2050s" = "2050",
"2080s" = "2080"))
),

                        column(3, 
                               selectInput("map.rcp",  span("Emissions Scenario:", style="color:brown; font-family: Calibri"),
                                           c("Medium" = "45",
                                             "High" = "85"))
                        )
                        ),actionButton('goMap', 'Go Map',icon("refresh")),
                      hr(),
                      leafletOutput("map", height = 500),
                      plotlyOutput("map.plot")
             ), # end of interactive map panel      

activeSubbasin <- reactiveVal()

output$map <- renderLeaflet({
input$goMap # Re-run when button is clicked
# Create 0-row data frame which will be used to store data
dat <- data.frame(x = numeric(0), y = numeric(0))

withProgress(message = 'Creating Map', value = 0, {
  # Number of times we'll go through the loop
  n <- 10
  
  for (i in 1:n) {
    # Each time through the loop, add another row of data. This is
    # a stand-in for a long-running computation.
    dat <- rbind(dat, data.frame(x = rnorm(1), y = rnorm(1)))
    
    # Increment the progress bar, and update the detail text.
    incProgress(1/n, detail = paste( i))
    
    # Pause for 0.1 seconds to simulate a long computation.
    Sys.sleep(0.1)
  }
})
# build the SQL query from the user selections
isolate(if (input$map.stype == "ann") {
  col.name <- columns.annual[grep(input$map.var, columns.annual)]
  proj.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_ann WHERE (period = ", input$map.period,
                       ") AND (rcp = ", input$map.rcp, ")")
  hist.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_ann WHERE (period = 1980)")
} else {
  col.name <- columns.month[grep(input$map.var, columns.month)]
  proj.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_month WHERE (period = ", input$map.period,
                       ") AND (rcp = ", input$map.rcp, ") AND (calendar_month = ", 
                       input$map.stype, ")")
  hist.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_month WHERE (period = 1980) AND (calendar_month = ", 
                       input$map.stype, ")")
})

# query the database
dat.proj <- dbGetQuery(db, proj.query)
dat.hist <- dbGetQuery(db, hist.query)

# rename the columns for use with different variables - enables the following code to be generic (for any variable)
colnames(dat.proj) <- c("value", "subbasin")
colnames(dat.hist) <- c("value", "subbasin")

# calculate the mean value by subbasin for the 10-member gcm ensemble
dat.proj.mean <- tapply(dat.proj$value, dat.proj$subbasin, mean)

# calculate the percent change relative to historical
pct.change <- ((dat.proj.mean - dat.hist$value) / dat.hist$value) * 100

# generate a color pallette from reactive expression output
mbreaks <- c(0, quantile(abs(pct.change), c(0.20, 0.4, 0.6, 0.8), na.rm = T), max(abs(pct.change), na.rm = T))
mbreaks <- ceiling(mbreaks)
mbreaks <- unique(c(rev(-1 * mbreaks), mbreaks))
pal <- colorBin(palette = "RdBu", domain = pct.change, bins = mbreaks)

id <- as.vector(basins$id)

leaflet() %>% 
  addProviderTiles("Stamen.TonerLite", group = "Toner Lite") %>% 
  addPolygons(data = basins, layerId = id, stroke = T, color = "black", 
              smoothFactor = 0.2, weight = 1, 
              fillColor = ~pal(pct.change), fillOpacity = 0.75, 
              popup = paste0(labels$label[grep(input$map.var, labels$input.var)], ": ", round(pct.change, 1)), 
              highlight = highlightOptions(weight = 2.5, fillOpacity = 1, bringToFront = T)) %>% 
  addLegend("bottomleft", pal = pal, values = pct.change,
            title = labels$label[grep(input$map.var, labels$input.var)],
            opacity = 0.75)

})

observeEvent(input$map_shape_click, { # update the location selectInput on map clicks
p <- input$map_shape_click
activeSubbasin(p$id)
print(activeSubbasin)
str(activeSubbasin)
})

Hi,

For a 'novice' R coder you're cranking out some pretty serious Shiny already :slight_smile:
The best way to ensure that updates only happen when a button is clicked, is putting all the code in an observeEvent that observes the botton. The observeEvent function had an innate isolate property as it will only react when a button is clicked, so all reactive variables in the function won't trigger anything till you click.

All I did was create the function, put all your code in it and made the final plot a reactive variable that will trigger the plot update:

library(shiny)
library(leaflet)
library(plotly)

ui <- navbarPage(title = span("Future Water Indiana",
                              style = "background-color: navy; color:white ; font-family: Calibri"),
                 tabPanel(span("Interactive map", style="color:olive; font-family: Calibri"),
                          fluidRow(
                            column(3,
                                   # input: select variable to map
                                   selectInput("map.var", span("Variable:", style="color:brown; font-family: Calibri"),
                                               c( "Precipiation" = "_precip",
                                                  "Evapotranspiration" = "_et",
                                                  "Soil water content" = "_sw",
                                                  "Groundwater Recharge" = "_perc",
                                                  "Baseflow" = "_gw_q",
                                                  "Streamflow" = "_flow_out",
                                                  "Water Yield" = "_wyld"))
                            ),
                            column(3,
                                   # input: select time period
                                   selectInput("map.stype", span("Summary Period:", style="color:brown; font-family: Calibri"),
                                               c("Annual" = "ann",
                                                 "January" = 1,
                                                 "February" = 2,
                                                 "March" = 3,
                                                 "April" = 4,
                                                 "May" = 5,
                                                 "June" = 6,
                                                 "July" = 7,
                                                 "August" = 8,
                                                 "September" = 9,
                                                 "October" = 10,
                                                 "November" = 11,
                                                 "December" = 12))
                            ),
                            column(3,
                                   # input: select time period
                                   selectInput("map.period", span("Time Period:", style="color:brown; font-family: Calibri"),
                                               c("2020s" = "2020",
                                                 "2050s" = "2050",
                                                 "2080s" = "2080"))
                            ), column(3, 
                                      selectInput("map.rcp",  span("Emissions Scenario:", style="color:brown; font-family: Calibri"),
                                                  c("Medium" = "45",
                                                    "High" = "85"))
                            )
                          ),actionButton('goMap', 'Go Map',icon("refresh")),
                          hr(),
                          leafletOutput("map", height = 500),
                          plotlyOutput("map.plot")
                 )) # end of interactive map panel   
                 
server <- function(input, output, session) {
                 activeSubbasin <- reactiveVal()
                 myLeaflet <- reactiveVal()
                 
                 observeEvent(input$goMap, {
                   # Re-run when button is clicked
                   # Create 0-row data frame which will be used to store data
                   dat <- data.frame(x = numeric(0), y = numeric(0))   
                   withProgress(message = 'Creating Map', value = 0, {
                     # Number of times we'll go through the loop
                     n <- 10
                     
                     for (i in 1:n) {
                       # Each time through the loop, add another row of data. This is
                       # a stand-in for a long-running computation.
                       dat <- rbind(dat, data.frame(x = rnorm(1), y = rnorm(1)))
                       
                       # Increment the progress bar, and update the detail text.
                       incProgress(1/n, detail = paste( i))
                       
                       # Pause for 0.1 seconds to simulate a long computation.
                       Sys.sleep(0.1)
                     }
                   })
                   # build the SQL query from the user selections
                   if (input$map.stype == "ann") {
                     col.name <- columns.annual[grep(input$map.var, columns.annual)]
                     proj.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_ann WHERE (period = ", input$map.period,
                                          ") AND (rcp = ", input$map.rcp, ")")
                     hist.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_ann WHERE (period = 1980)")
                   } else {
                     col.name <- columns.month[grep(input$map.var, columns.month)]
                     proj.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_month WHERE (period = ", input$map.period,
                                          ") AND (rcp = ", input$map.rcp, ") AND (calendar_month = ", 
                                          input$map.stype, ")")
                     hist.query <- paste0("SELECT ", col.name, ", subbasin FROM hydro_month WHERE (period = 1980) AND (calendar_month = ", 
                                          input$map.stype, ")")
                   }
                   
                   # query the database
                   dat.proj <- dbGetQuery(db, proj.query)
                   dat.hist <- dbGetQuery(db, hist.query)
                   
                   # rename the columns for use with different variables - enables the following code to be generic (for any variable)
                   colnames(dat.proj) <- c("value", "subbasin")
                   colnames(dat.hist) <- c("value", "subbasin")
                   
                   # calculate the mean value by subbasin for the 10-member gcm ensemble
                   dat.proj.mean <- tapply(dat.proj$value, dat.proj$subbasin, mean)
                   
                   # calculate the percent change relative to historical
                   pct.change <- ((dat.proj.mean - dat.hist$value) / dat.hist$value) * 100
                   
                   # generate a color pallette from reactive expression output
                   mbreaks <- c(0, quantile(abs(pct.change), c(0.20, 0.4, 0.6, 0.8), na.rm = T), max(abs(pct.change), na.rm = T))
                   mbreaks <- ceiling(mbreaks)
                   mbreaks <- unique(c(rev(-1 * mbreaks), mbreaks))
                   pal <- colorBin(palette = "RdBu", domain = pct.change, bins = mbreaks)
                   
                   id <- as.vector(basins$id)
                   
                   myLeaflet(leaflet() %>% 
                     addProviderTiles("Stamen.TonerLite", group = "Toner Lite") %>% 
                     addPolygons(data = basins, layerId = id, stroke = T, color = "black", 
                                 smoothFactor = 0.2, weight = 1, 
                                 fillColor = ~pal(pct.change), fillOpacity = 0.75, 
                                 popup = paste0(labels$label[grep(input$map.var, labels$input.var)], ": ", round(pct.change, 1)), 
                                 highlight = highlightOptions(weight = 2.5, fillOpacity = 1, bringToFront = T)) %>% 
                     addLegend("bottomleft", pal = pal, values = pct.change,
                               title = labels$label[grep(input$map.var, labels$input.var)],
                               opacity = 0.75))
                 })
                 
                 output$map <- renderLeaflet({
                   myLeaflet()
                 })
                 
                 observeEvent(input$map_shape_click, { # update the location selectInput on map clicks
                   p <- input$map_shape_click
                   activeSubbasin(p$id)
                   print(activeSubbasin)
                   str(activeSubbasin)
                 })
}
shinyApp(ui, server)

You did not include any data, so I couldn't verify everything as the missing dataset generates errors and empty plot.

Hope this helps,
PJ

1 Like

Thanks for the response PJ and sorry for the delayed reply. I tried changing the code to what you listed, but I'm getting an error in sourcing. I actually didn't create this code, I'm just trying to make some parts of the app more intuitive/smoother. Here's the full code: https://github.com/richuang1/R-Shiny/blob/master/app_redesign_2.R

Thanks again for your help!

HI,

There are at least two reasons the gitHub code is giving me errors:

  1. There is a redundant } on line 277 you need to get rid of
  2. The dataset required is not available as it is located on the user's local drive
basins <- readOGR(dsn = "C:/Users/lomei/Downloads/simpleshp/simpleshp_03.shp", stringsAsFactors = F)

If you fix these two things, then implement my suggestion, it might work. Again, I don't have the data so can't double check by running the app...

PJ

I apologize, I have no idea why that code was uploaded on GitHub, I thought I uploaded the updated version. I uploaded a new file called "app_redesign3" and I tried doing your suggestion. I think this fixed the redundant }. I have the dataset saved locally but I'm not sure if I can distribute it to others currently. Thanks again PJ

Hi,

Well keep me posted on the progress.

PJ

I would still very much appreciate your insight/help that you offer. These are the errors I'm receiving currently.

Error in parse(file, keep.source = FALSE, srcfile = src, encoding = enc) :
C:/Users/lomei/Desktop/SWAT_Visualization/app_redesign_3.R:199:30: unexpected '{'
198:
199: observeEvent(input$goMap {
^
Possible missing comma at:
207: for (i in 1:n) {
^
Possible missing comma at:
207: for (i in 1:n) {
^
Possible missing comma at:
370: for (i in 1:n) {
^
Possible missing comma at:
370: for (i in 1:n) {
^
Error in sourceUTF8(fullpath, envir = new.env(parent = globalenv())) :
Error sourcing C:\Users\lomei\AppData\Local\Temp\Rtmpagmjuw\file499c13a3586c

Hi,

You can usually fix these errors easily by going to the line reported in the error and looking at what's wrong.

The observeEvent was missing a comma:

observeEvent(input$goMap {...
observeEvent(input$goMap, {...

The other errors fixed themselves after that one was fixed. Always fix the first error first, then run code and see if the others change.

One more thing I changed:

basins@data$id <- as.numeric(basins@data$Subbasin)
basins$data$id <- as.numeric(basins$data$Subbasin)

Unless there is a special case I'm not aware of where you use @, I think you meant $

Again, with no datasets I can't test the full code. But just try and work through the error messages yourself first, as that will save you time waiting for us to respond (many are easy fix).

Goof luck
PJ

The filters now work properly! None of the filters automatically update the map. The only thing that I want to add is a display of the map with the default filters when the page is initially loaded. Currently, there is nothing there but only the filters+actionbutton where as i want the filters+actionbutton+map when initially loaded. Thanks so much PJ, you're a life saver!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.