英文:
Icon not changing on leaflet map in a r shiny application
问题
I can provide a translation of the code you've posted. Please note that I'll omit the code comments and provide the translated code only:
# libraries ----
library(tidyverse)
library(sf)
library(mapview)
library(scales)
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(tidygeocoder)
# Select input data
selectInput_data <- readRDS(file = "www/select_item_data.rds")
icon_tbl <- read_rds("www/icon_tbl.rds")
# Define UI for the application
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
br(),
fileInput("upload", "Upload Reference geodata file"),
hr(),
shiny::selectInput("datasetLevel", "Select Dataset Level",
c("National" = "national", "State" = "state")),
shiny::conditionalPanel(
condition = "input.datasetLevel == 'state'",
shiny::selectInput(inputId = "mapState",
label = "Select State:", choices = c(Choose = '', selectInput_data$state_values))
),
shiny::selectInput("sector", "Select Uploaded dataset Sector",
c("Administrative Boundaries" = "admin", "Agriculture" = "agriculture",
"Commerce" = "commerce", "Education" = "education", "Energy" = "energy",
"Health and Safety" = "health_safety", "Population" = "population",
"Public Facilities" = "public-facilities", "Religion" = "religion",
"Security" = "security", "Water and Sanitation" = "water_sanitation")),
uiOutput("agric_output"),
uiOutput("commerce_output"),
uiOutput("edu_output"),
uiOutput("energy_output"),
uiOutput("health_output"),
uiOutput("public_output"),
uiOutput("religion_output"),
uiOutput("security_output"),
uiOutput("water_san_output"),
actionButton(inputId = "submitButton", label = "Submit"),
br()
),
mainPanel(uiOutput("lfMap"))
)
)
# Define server logic
server <- function(input, output) {
# UI section
output$agric_output <- renderUI({
req(input$sector == 'agriculture')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Farmland")
)
})
output$commerce_output <- renderUI({
req(input$sector == 'commerce')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Factories/Industrial Sites", "Filling Stations", "Market")
)
})
output$edu_output <- renderUI({
req(input$sector == 'education')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Primary Schools", "Private Schools", "Public Schools", "Secondary Schools", "Tertiary Schools")
)
})
output$energy_output <- renderUI({
req(input$sector == 'energy')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Electricity Sub-stations")
)
})
output$health_output <- renderUI({
req(input$sector == 'health_safety')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Ambulance Emergency Services", "Fire Station", "Health Care Facilities (Primary, Secondary, Tertiary)",
"Laboratories", "Pharmaceutical Facilities")
)
})
output$public_output <- renderUI({
req(input$sector == 'public-facilities')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Government Buildings", "Post Office", "Road")
)
})
output$religion_output <- renderUI({
req(input$sector == 'religion')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Churches", "Mosques")
)
})
output$security_output <- renderUI({
req(input$sector == 'security')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Prison", "Police Stations")
)
})
output$water_san_output <- renderUI({
req(input$sector == 'water_sanitation')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Dump Sites", "Public Water Points", "Enviromental Sites", "Water Bodies", "Waterway")
)
})
userFile <- reactive({
req(!is.null(input$upload))
validate(need(input$upload, message = FALSE))
sf::st_read(input$upload$datapath) |>
mutate(label = paste("<center>", sep = "<br/>", "<b>", toupper(name), "</b>", "</center>"))
})
geo_icon <- reactive({
req(!is.null(input$subSector))
validate(need(input$upload, message = FALSE))
ic <- icons(
iconUrl = icon_tbl |>
filter(sub_sector == input$subSector) |>
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
})
observeEvent(c(input$subSector, input$submitButton), {
geo_icon <- reactive({
ic <- icons(
iconUrl = icon_tbl |>
filter(sub_sector == input$subSector) |>
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
ic
})
output$lfMap <- renderUI({
req(input$submitButton)
g_map <- leaflet(userFile()) |>
addProviderTiles(providers$CartoDB.Positron) |>
setView(lng = 7.5248, lat = 5.4527, zoom = 3) |>
addMarkers(
popup = ~label,
icon = geo_icon(),
clusterOptions = markerClusterOptions(zoomToBoundsOnClick = TRUE)
)
g_map
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Please note that this is a direct translation of the code, and I haven't reviewed the functionality or logic of the code. If you have any specific questions or need further assistance with this code, please let me know.
英文:
I am working on a shiny application in which I want to change the icons displayed on the leaflet map anytime the user changes the sub-sector selection on the input$sub_sector
. The app works well when loaded at first but does not change the icons when the user changes the sub-sector options. The URL to icon images is stored in a tibble saved as an rds file loaded when the app starts. Kindly help me review the code as shown below.
#
# libraries ----
library(tidyverse) # collection of R packages designed for data science
library(sf) # Used for creating simple features objects
library(mapview) # Used for creating interactive maps
library(scales)
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(tidygeocoder) # Used for geocoding
# selectIput data
selectInput_data <- readRDS(file = "www/select_item_data.rds")
icon_tbl <- read_rds("www/icon_tbl.rds")
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
br(),
fileInput("upload", "Upload Reference geodata file"),
hr(),
shiny::selectInput("datasetLevel", "Select Dataset Level",
c("National" = "national",
"State" = "state")),
# Only show this panel if the Agriculture is selected
shiny::conditionalPanel(
condition = "input.datasetLevel == 'state'",
shiny::selectInput(inputId = "mapState",
label = "Select State:",
choices = c(Choose='', selectInput_data$state_values))
),
shiny::selectInput("sector", "Select Uploaded dataset Sector",
c("Administrative Boundaries" = "admin",
"Agriculture" = "agriculture",
"Commerce" = "commerce",
"Education" = "education",
"Energy" = "energy",
"Health and Safety" = "health_safety",
"Population" = "population",
"Public Facilities" = "public-facilities",
"Religion" = "religion",
"Security" = "security",
"Water and Sanitation" = "water_sanitation")),
uiOutput("agric_output"),
uiOutput("commerce_output"),
uiOutput("edu_output"),
uiOutput("energy_output"),
uiOutput("health_output"),
uiOutput("public_output"),
uiOutput("religion_output"),
uiOutput("security_output"),
uiOutput("water_san_output"),
actionButton(inputId = "submitButton",
label = "Submit"),
br()
),
# Show a plot of the generated distribution
mainPanel(
uiOutput("lfMap")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
## UI section
output$agric_output <- renderUI({
req(input$sector == 'agriculture')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Farmland")
)
})
output$commerce_output <- renderUI({
req(input$sector == 'commerce')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Factories/Industrial Sites", "Filling Stations",
"Market")
)
})
output$edu_output <- renderUI({
req(input$sector == 'education')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Primary Schools", "Private Schools",
"Public Schools","Secondary Schools",
"Tertiary Schools")
)
})
output$energy_output <- renderUI({
req(input$sector == 'energy')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Electricity Sub-stations")
)
})
output$health_output <- renderUI({
req(input$sector == 'health_safety')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Ambulance Emergency Services", "Fire Station",
"Health Care Facilities (Primary, Secondary, Tertiary)",
"Laboratories","Pharmaceutical Facilities")
)
})
output$public_output <- renderUI({
req(input$sector == 'public-facilities')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Government Buildings", "Post Office",
"Road")
)
})
output$religion_output <- renderUI({
req(input$sector == 'religion')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Churches", "Mosques")
)
})
output$security_output <- renderUI({
req(input$sector == 'security')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Prison", "Police Stations")
)
})
output$water_san_output <- renderUI({
req(input$sector == 'water_sanitation')
shiny::selectInput(
"subSector", "Select Sub Sector",
c("Dump Sites", "Public Water Points",
"Enviromental Sites","Water Bodies","Waterway")
)
})
userFile <- reactive({
req(!is.null(input$upload))
# If no file is selected, don't do anything
validate(need(input$upload, message = FALSE))
sf::st_read(input$upload$datapath) |>
mutate(label=paste("<center>",
sep = "<br/>",
"<b>",toupper(name),"</b>",
"</center>"))
})
geo_icon <- reactive({
req(!is.null(input$subSector))
validate(need(input$upload, message = FALSE))
ic=icons(
iconUrl = icon_tbl |>
filter(sub_sector == input$sub_sector) |>
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
})
observeEvent(c(input$subSector, input$submitButton), {
geo_icon <- reactive({
ic <- icons(
iconUrl = icon_tbl |>
filter(sub_sector == input$subSector) |>
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
ic
})
output$lfMap <- renderUI({
req(input$submitButton)
g_map <- leaflet(userFile()) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng = 7.5248,
lat = 5.4527,
zoom = 3) %>%
addMarkers(
popup = ~ label,
icon = geo_icon(),
clusterOptions = markerClusterOptions(zoomToBoundsOnClick = TRUE)
)
g_map
})
})
# reactive map update
# observe({
# leafletProxy("lfMap", data = userFile()) |>
# clearMarkerClusters() |>
# clearShapes() |>
# clearMarkers() |>
# addMarkers(
# popup = ~label,
# icon = geo_icon(),
# clusterOptions = markerClusterOptions(zoomToBoundsOnClick = TRUE)
# )
# })
#
}
# Run the application
shinyApp(ui = ui, server = server)
Sample geospatial data is available from the github repo. Thank you
github repo
答案1
得分: 1
在你的第一个 geo_icon
中,我认为有一个拼写错误:
filter(sub_sector == input$sub_sector)
应该是
filter(sub_sector == input$subSector)
为什么你有两个 geo_icons
??
第二个没有正确构建。你将它嵌套在一个观察器中,这是不好的。删除这个观察器,改用 eventReactive
:
geo_icon <- eventReactive(c(input$subSector, input$submitButton), {
ic <- icons(
iconUrl = icon_tbl %>%
filter(sub_sector == input$subSector) %>%
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
ic
})
不太重要,但你的一堆 renderUI
看起来有点奇怪。我会使用 switch
只做一个 uiOutput("subSectorUI")
:
output$subSectorUI <- renderUI({
choices <- switch(input$sector,
agriculture = "Farmland",
commerce = c("Factories/Industrial Sites", "Filling Stations",
"Market"),
education = c("Primary Schools", "Private Schools",
"Public Schools","Secondary Schools",
"Tertiary Schools"),
.......
)
selectInput(
"subSector", "Select Sub Sector", choices
)
})
英文:
In your first geo_icon
there is a typo I think:
filter(sub_sector == input$sub_sector)
should be
filter(sub_sector == input$subSector)
Why do you have two geo_icons
???
The second one is not correctly constructed. You nested it in an observer, and that's bad. Remove this observer and use eventReactive
instead:
geo_icon <- eventReactive(c(input$subSector, input$submitButton), {
ic <- icons(
iconUrl = icon_tbl |>
filter(sub_sector == input$subSector) |>
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
ic
})
Less important, but your bunch of renderUI
is strange. I would do only one uiOutput("subSectorUI")
with the help of switch
:
output$subSectorUI <- renderUI({
choices <- switch(input$sector,
agriculture = "Farmland",
commerce = c("Factories/Industrial Sites", "Filling Stations",
"Market"),
education = c("Primary Schools", "Private Schools",
"Public Schools","Secondary Schools",
"Tertiary Schools"),
.......
)
selectInput(
"subSector", "Select Sub Sector", choices
)
})
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论