在rshine应用程序中,瓣叶图上的图标未发生变化

b4wnujal  于 2023-05-26  发布在  其他
关注(0)|答案(1)|浏览(206)

我正在开发一个闪亮的应用程序,我想在用户更改input$sub_sector上的子扇区选择时更改传单Map上显示的图标。该应用程序在第一次加载时运行良好,但当用户更改子部门选项时不会更改图标。图标图像的URL存储在应用程序启动时加载的rds文件中。请帮我检查代码如下所示。

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

示例地理空间数据可从github repo获得。谢谢github repo

bvjxkvbb

bvjxkvbb1#

在您的第一个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
  )
})

相关问题