如何在RShiny中建立动态的Leaflet Map?

问题描述

我是Shiny的初学者，并尝试构建一个闪亮的应用，用户可以从下拉菜单中选择 State 位置，然后基于 lat &long 应该绘制在 leaflet 地图上.

I am a beginner in Shiny and trying to build a shiny app where a user can select State location from drop down and then based on those the lat & long should be plotted on the leaflet map.

我看过几篇 SO 帖子，例如和闪亮教程 https://shiny.rstudio.com/tutorial/write-tutorial/lesson6/，但是没有任何事情可以完全根据下拉选择使其动态化.

I have looked at several SO post like Shiny dropdown menu selection to filter a dataframe and shiny tutorials https://shiny.rstudio.com/tutorial/written-tutorial/lesson6/ but nothing has completely worked to make it dynamic based on dropdown selection.

我也尝试在我在下面发布的最新代码尝试中使用 reactive().

I have also tried using reactive() in my latest code attempt which I have posted below.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(leaflet)
library(readxl)
library(RCurl)

URL <- "https://www.mohfw.gov.in/pdf/PMJAYPRIVATEHOSPITALSCONSOLIDATED.xlsx"
download.file(URL, destfile = "../../timesnow_PMJAYPRIVATEHOSPITALSCONSOLIDATED.xlsx",method = "curl")

# Data
ind_vaccination_center <- readxl::read_xlsx(path = "../../timesnow_PMJAYPRIVATEHOSPITALSCONSOLIDATED.xlsx",
                                             sheet = 1)

# Creating column with html tags for popup & saving in new df
ind_vaccination_leaflet <- ind_vaccination_center %>% 
    mutate(label_display = paste(
        "<h2>", ind_vaccination_center$`Name of the Vaccination Site*`, "</h2>",
        "<h4>",ind_vaccination_center$`District*`,",", ind_vaccination_center$`State*`, "</h4>",
        "<p>", "Address: ", ind_vaccination_center$Address,",", ind_vaccination_center$`PinCode*`, "</p>",
        "<p>", "Mobile: ", ind_vaccination_center$`Mobile Number`, "</p>",
        "<p>", "Contact Person: ", ind_vaccination_center$`Contact Person`, "</p>"
    )
    )

# Define UI for application
ui <- fluidPage(

    # Application title
    titlePanel("Covid19 Vaccination Centers in India"),

    # Sidebar with Dropown selection 
    sidebarLayout(
        
        sidebarPanel(
            selectInput(inputId = "state_selection",
                        label = "Select State", 
                        choices = ind_vaccination_center$`State*`),
            
            h3("List of Vaccination Centers is plotted on Map & also listed in searchable table."),
                     
                     "source of list:",
                     a("https://www.timesnownews.com/india/article/covid-19-vaccination-in-uttar-pradesh-check-complete-list-of-govt-and-private-hospitals-for-jab/726412"),
                     br(),
                     br(),

                     a("https://www.oneindia.com/india/full-list-of-private-hospitals-where-the-covid-19-vaccine-will-be-administered-3223706.html"),
                     br(),
                     br(),
                     "P.S - There might be more center's added to this list, kindly recheck from other sources as well like:",
                     br(),
                     a("https://www.cowin.gov.in/home")
                     ),
        

        # Show a map
        mainPanel(
            leafletOutput("map",height = 800, width = "100%")
        )
    )
)

# Define server logic
server <- function(input, output) {
    
    dataInput <- reactive({
        ind_vaccination_leaflet <- ind_vaccination_leaflet %>% 
            filter(`State*` == input$state_selection)
    })
    
    
    output$map <- renderLeaflet({
        
        # Creating map object & adding layers
        leaflet(dataInput()) %>%
            
            setView(lat = 26.64510, lng = 80.17012, zoom = 4) %>%
            addTiles(group = "OSM") %>%
            addProviderTiles(providers$CartoDB.DarkMatter, group = "Dark") %>%
            addProviderTiles(providers$CartoDB.Positron, group = "Light") %>%
            addProviderTiles("Stamen.Terrain", group = "Terrain") %>%
            addProviderTiles("Esri.WorldImagery", group = "WorldImagery") %>%
            addLayersControl(baseGroups = c("OSM","WorldImagery","Dark","Light","Terrain")) %>%
            addCircleMarkers(
                lng = ind_vaccination_leaflet$`Longitude*`,
                lat = ind_vaccination_leaflet$`Latitude*`,
                label = lapply(ind_vaccination_leaflet$label_display, htmltools::HTML),
                color = "midnightblue",
                weight = 1,
                radius = 8
            )%>%
            addMiniMap(tiles = providers$OpenStreetMap, width = 120, height=80)
        
    })
}



# Run the application 
shinyApp(ui = ui, server = server)

推荐答案

将服务器逻辑更改为:

server <- function(input, output) {

  output$map <- renderLeaflet({
    
    req(input$state_selection)
    data <- ind_vaccination_leaflet %>% filter(`State*` == input$state_selection)
    
    
    leaflet(data) %>%
      setView(lat = 26.64510, lng = 80.17012, zoom = 4) %>%
      addTiles(group = "OSM") %>%
      addProviderTiles(providers$CartoDB.DarkMatter, group = "Dark") %>%
      addProviderTiles(providers$CartoDB.Positron, group = "Light") %>%
      addProviderTiles("Stamen.Terrain", group = "Terrain") %>%
      addProviderTiles("Esri.WorldImagery", group = "WorldImagery") %>%
      addLayersControl(baseGroups = c("OSM","WorldImagery","Dark","Light","Terrain")) %>%
      addCircleMarkers(
        lng = ~`Longitude*`,
        lat = ~`Latitude*`,
        label = lapply(data$label_display, htmltools::HTML),
        color = "midnightblue",
        weight = 1,
        radius = 8
      )%>%
      addMiniMap(tiles = providers$OpenStreetMap, width = 120, height=80)
    
  })
}

这篇关于如何在RShiny中建立动态的Leaflet Map?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！