...
I'm having a problem since I started learning shiny and R, so please be patient.
I'm working on a shiny map where whenever a user clicks on a polygon, it changes the first selection to the same area that the user picked on the map.
This is my code:
# Install an load all required packages
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, data.table, bslib, shiny, sf, leaflet, tiff, openxlsx, rgdal, purrr)
# set working directory to this script's locations: no need to check the file path manually
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
# Add the layers and the map
dir.layers <- "syr_admin_20200816.gdb"
df <- st_read(dir.layers, layer="syr_admbnda_adm1_uncs_unocha") %>%
st_transform(crs = 4326) %>%
st_zm(df, drop = TRUE) %>%
select(name=admin1Pcode, shape=SHAPE)
df <- subset(df, df$name %in% c("SY01", "SY02", "SY03", "SY04", "SY05", "SY06", "SY07"))
#leaflet(df) %>%
# addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
# opacity = 1.0, fillOpacity = 0.5,
# highlightOptions = highlightOptions(color = "white", weight = 2,
# bringToFront = TRUE))
#ui
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "minty"),
# App title ----
navbarPage(title = "Flood-Model Shiny App",
tags$script(HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right\"><img src=\"cwg.jpg\" alt=\"alt\" style=\"float:right;width:auto;height:35px;padding-top:0px;\"> </a>`</div>');
console.log(header)")
)),
# Sidebar panel for inputs ----
sidebarLayout(
position = "right",
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a Location:",
choices = c("location_A", "Location_B",
"Location_C", "Location_D",
"Location_E", "Location_F")),
# Input: choose file
uiOutput("secondSelection"),
# Button
downloadButton("downloadData", "Download")),
# Main panel for displaying outputs ----
mainPanel(
#loading the map in Output layer
leafletOutput("map"),
#loading the map information after hover on the map
uiOutput('map_text')
)))
# Define server logic to display and download selected file ----
server <- function(input, output, session) {
output$map <- renderUI({
HTML(paste(h4(map$name)))
})
output$map <- renderLeaflet({
leaflet(df) %>%
addPolygons(color = "gray", fillColor = "blue", weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 0.5,
layerId = ~name,
highlightOptions = highlightOptions(color = "white", weight = 2,
bringToFront = TRUE)) %>%
addTiles()
#addProviderTiles("Esri.WorldImagery")
})
# Table of selected file ----
output$secondSelection <- renderUI({
database <- input$dataset
selectInput( "file", "Choose a file:", choices =
switch(database,
"location_A" = c("A_flood_Hazard","A_flood_depth") ,
"Location_B" = c("B_flood_Hazard","B_flood_depth"),
"Location_C" = c("C_flood_Hazard","C_flood_depth"),
"Location_D" = c("D_flood_Hazard","D_flood_depth"),
"Location_E" = c("E_flood_Hazard","E_flood_depth"),
"Location_F" = c("F_flood_Hazard","F_flood_depth")))
})
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$file,
"A_flood_Hazard" = A_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"A_flood_depth" = A_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"B_flood_Hazard" = B_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"B_flood_depth" = B_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"C_flood_Hazard" = C_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"C_flood_depth" = C_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"D_flood_Hazard" = D_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"D_flood_depth" = D_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"E_flood_Hazard" = E_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"E_flood_depth" = E_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"F_flood_Hazard" = F_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
"F_flood_depth" = F_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") )
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$file, ".tif.tif", sep = "")
},
content = function(file) {
writeTIFF(datasetInput(), file )
}
)
#Event click on map
observe({
event <- input$map_shape_click
as.character(event$id)
updateSelectInput(session,
inputId = "dataset",
choices = switch(event$id,
"SY04" = "location_A",
"SY01" = "Location_B",
"SY02" = "Location_C",
"SY03" = "Location_D",
"SY05" = "Location_E",
"SY06" = "Location_F" ))
})
}
# Create Shiny app ----
shinyApp(ui, server)
whenever I start the app it gives me this error
the error is Error in switch: EXPR must be a length 1 vector