Icon not changing on leaflet map in a r shiny application

huangapple go评论71阅读模式
英文:

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 &lt;- readRDS(file = &quot;www/select_item_data.rds&quot;)
icon_tbl &lt;- read_rds(&quot;www/icon_tbl.rds&quot;)
# Define UI for application that draws a histogram
ui &lt;- fluidPage(
# Application title
titlePanel(&quot;Old Faithful Geyser Data&quot;),
# Sidebar with a slider input for number of bins 
sidebarLayout(
sidebarPanel(
br(),
fileInput(&quot;upload&quot;, &quot;Upload Reference geodata file&quot;),
hr(),
shiny::selectInput(&quot;datasetLevel&quot;, &quot;Select Dataset Level&quot;,
c(&quot;National&quot; = &quot;national&quot;,
&quot;State&quot; = &quot;state&quot;)),
# Only show this panel if the Agriculture is selected
shiny::conditionalPanel(
condition = &quot;input.datasetLevel == &#39;state&#39;&quot;,
shiny::selectInput(inputId = &quot;mapState&quot;,
label = &quot;Select State:&quot;,
choices = c(Choose=&#39;&#39;, selectInput_data$state_values))
),
shiny::selectInput(&quot;sector&quot;, &quot;Select Uploaded dataset Sector&quot;,
c(&quot;Administrative Boundaries&quot; = &quot;admin&quot;,
&quot;Agriculture&quot; = &quot;agriculture&quot;,
&quot;Commerce&quot; = &quot;commerce&quot;,
&quot;Education&quot; = &quot;education&quot;,
&quot;Energy&quot; = &quot;energy&quot;,
&quot;Health and Safety&quot; = &quot;health_safety&quot;,
&quot;Population&quot; = &quot;population&quot;,
&quot;Public Facilities&quot; = &quot;public-facilities&quot;,
&quot;Religion&quot; = &quot;religion&quot;,
&quot;Security&quot; = &quot;security&quot;,
&quot;Water and Sanitation&quot; = &quot;water_sanitation&quot;)),
uiOutput(&quot;agric_output&quot;),
uiOutput(&quot;commerce_output&quot;),
uiOutput(&quot;edu_output&quot;), 
uiOutput(&quot;energy_output&quot;),
uiOutput(&quot;health_output&quot;), 
uiOutput(&quot;public_output&quot;),
uiOutput(&quot;religion_output&quot;),
uiOutput(&quot;security_output&quot;),
uiOutput(&quot;water_san_output&quot;),
actionButton(inputId = &quot;submitButton&quot;,
label = &quot;Submit&quot;),
br()
),
# Show a plot of the generated distribution
mainPanel(
uiOutput(&quot;lfMap&quot;)
)
)
)
# Define server logic required to draw a histogram
server &lt;- function(input, output) {
## UI section
output$agric_output &lt;- renderUI({
req(input$sector == &#39;agriculture&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Farmland&quot;)
)
})
output$commerce_output &lt;- renderUI({
req(input$sector == &#39;commerce&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Factories/Industrial Sites&quot;, &quot;Filling Stations&quot;,
&quot;Market&quot;)
)
})
output$edu_output &lt;- renderUI({
req(input$sector == &#39;education&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Primary Schools&quot;, &quot;Private Schools&quot;,
&quot;Public Schools&quot;,&quot;Secondary Schools&quot;,
&quot;Tertiary Schools&quot;)
)
})
output$energy_output &lt;- renderUI({
req(input$sector == &#39;energy&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Electricity Sub-stations&quot;)
)
})
output$health_output &lt;- renderUI({
req(input$sector == &#39;health_safety&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Ambulance Emergency Services&quot;, &quot;Fire Station&quot;,
&quot;Health Care Facilities (Primary, Secondary, Tertiary)&quot;,
&quot;Laboratories&quot;,&quot;Pharmaceutical Facilities&quot;)
)
})
output$public_output &lt;- renderUI({
req(input$sector == &#39;public-facilities&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Government Buildings&quot;, &quot;Post Office&quot;,
&quot;Road&quot;)
)
})
output$religion_output &lt;- renderUI({
req(input$sector == &#39;religion&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Churches&quot;, &quot;Mosques&quot;)
)
})
output$security_output &lt;- renderUI({
req(input$sector == &#39;security&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Prison&quot;, &quot;Police Stations&quot;)
)
})
output$water_san_output &lt;- renderUI({
req(input$sector == &#39;water_sanitation&#39;)
shiny::selectInput(
&quot;subSector&quot;, &quot;Select Sub Sector&quot;,
c(&quot;Dump Sites&quot;, &quot;Public Water Points&quot;,
&quot;Enviromental Sites&quot;,&quot;Water Bodies&quot;,&quot;Waterway&quot;)
)
})
userFile &lt;- reactive({
req(!is.null(input$upload))
# If no file is selected, don&#39;t do anything
validate(need(input$upload, message = FALSE))
sf::st_read(input$upload$datapath) |&gt;
mutate(label=paste(&quot;&lt;center&gt;&quot;,
sep = &quot;&lt;br/&gt;&quot;,
&quot;&lt;b&gt;&quot;,toupper(name),&quot;&lt;/b&gt;&quot;,
&quot;&lt;/center&gt;&quot;))
})
geo_icon &lt;- reactive({
req(!is.null(input$subSector))
validate(need(input$upload, message = FALSE))
ic=icons(
iconUrl = icon_tbl |&gt;
filter(sub_sector == input$sub_sector) |&gt;
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 &lt;- reactive({
ic &lt;-  icons(
iconUrl = icon_tbl |&gt;
filter(sub_sector == input$subSector) |&gt;
pull(icon_url),
iconWidth = 40,
iconHeight = 40,
iconAnchorX = 22,
iconAnchorY = 30,
shadowWidth = 50,
shadowHeight = 50,
shadowAnchorX = 4,
shadowAnchorY = 62
)
ic
})
output$lfMap &lt;- renderUI({
req(input$submitButton)
g_map &lt;- leaflet(userFile()) %&gt;%
addProviderTiles(providers$CartoDB.Positron) %&gt;%
setView(lng = 7.5248,
lat = 5.4527,
zoom = 3) %&gt;%
addMarkers(
popup = ~ label,
icon = geo_icon(),
clusterOptions = markerClusterOptions(zoomToBoundsOnClick = TRUE)
)
g_map
})
})
# reactive map update
# observe({
#   leafletProxy(&quot;lfMap&quot;, data = userFile()) |&gt; 
#     clearMarkerClusters() |&gt; 
#     clearShapes() |&gt; 
#     clearMarkers() |&gt;  
#     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 &lt;- eventReactive(c(input$subSector, input$submitButton), {
  ic &lt;- icons(
    iconUrl = icon_tbl |&gt;
      filter(sub_sector == input$subSector) |&gt;
      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(&quot;subSectorUI&quot;) with the help of switch:

output$subSectorUI &lt;- renderUI({
  choices &lt;- switch(input$sector, 
                    agriculture = &quot;Farmland&quot;,
                    commerce = c(&quot;Factories/Industrial Sites&quot;, &quot;Filling Stations&quot;,
                                 &quot;Market&quot;),
                    education = c(&quot;Primary Schools&quot;, &quot;Private Schools&quot;,
                                  &quot;Public Schools&quot;,&quot;Secondary Schools&quot;,
                                  &quot;Tertiary Schools&quot;),
                    .......
            )
  selectInput(
    &quot;subSector&quot;, &quot;Select Sub Sector&quot;, choices
  )
})

huangapple
  • 本文由 发表于 2023年5月24日 19:55:21
  • 转载请务必保留本文链接:https://go.coder-hub.com/76323243.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定