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)
})