Select 闪亮应用程序中地图上的州
Select states on a map in a Shiny Application
我正在尝试重现这个出色的答案：
我有以下可用数据集：
library(rgdal)
library(leaflet)
tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>Estado: </strong>",
mexico$name,
"<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>",
mexico$gdp08)
在此数据之上，我构建了以下 Shiny 应用程序：
# load necessary packages
library( leaflet )
library( shiny )
library( shinydashboard )
ui <- fluidPage(
# place the contents inside a box
shinydashboard::box(
width = 12
, title = "Click on the map!"
# separate the box by a column
, column(
width = 2
, shiny::actionButton( inputId = "clearHighlight"
, icon = icon( name = "eraser")
, label = "Clear the Map"
, style = "color: #fff; background-color: #D75453; border-color: #C73232"
)
)
# separate the box by a column
, column(
width = 10
, leaflet::leafletOutput( outputId = "myMap"
, height = 850
)
)
) # end of the box
) # end of fluid page
# create the server
server <- function( input, output, session ){
# create foundational map
foundational.map <- shiny::reactive({
leaflet() %>%
#addTiles( urlTemplate = "https://cartodb-basemaps-{s}.global.ssl.fastly.net/light_all/{z}/{x}/{y}.png") %>%
#setView( lng = -87.567215
# , lat = 41.822582
# , zoom = 11 ) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons( data = mexico
, fillOpacity = 0
, opacity = 0.2
, color = "#000000"
, weight = 2
, layerId = mexico$states
, group = "click.list"
)
})
output$myMap <- renderLeaflet({
foundational.map()
})
click.list <- shiny::reactiveValues( ids = vector() )
shiny::observeEvent( input$myMap_shape_click, {
click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$states %in% click.list$ids ) , ]
if( is.null( click$id ) ){
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
leaflet::leafletProxy( mapId = "myMap" ) %>%
addPolylines( data = lines.of.interest
, layerId = lines.of.interest@data$id
, color = "#6cb5bc"
, weight = 5
, opacity = 1
)
} # end of if else statement
}) # end of shiny::observeEvent({})
shiny::observeEvent( input$clearHighlight, {
output$myMap <- leaflet::renderLeaflet({
click.list$ids <- NULL
foundational.map()
}) # end of re-rendering $myMap
}) # end of clearHighlight action button logic
} # end of server
shiny::shinyApp( ui = ui, server = server)
基本地图有效。但是，我想要实现的是，当我单击状态边界时，它会围绕该状态放置。这应该通过以下代码发生：
click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$states %in% click.list$ids ) , ]
if( is.null( click$id ) ){
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
leaflet::leafletProxy( mapId = "myMap" ) %>%
addPolylines( data = lines.of.interest
, layerId = lines.of.interest@data$id
, color = "#6cb5bc"
, weight = 5
, opacity = 1
)
}
但显然有些地方不对劲。有什么问题吗？
事实证明这个问题很容易解决（一旦你知道去哪里找）。你引用了两次 mexico$states，而它应该是 mexico$state，所以我删除了两个字母，现在它可以工作了。请参阅下面的代码。
也许添加我是如何发现这一点的也很好，这样您就知道将来如何调试类似的问题。在 observeEvent 中，我添加了 print(click)。其输出是：
$id
NULL
$.nonce
[1] 0.2851101
$group
[1] "click.list"
$lat
[1] 22.26199
$lng
[1] -100.2037
然后我们看到点击的id有问题！从那里很容易看出错误，多边形的 ids mexico$states，而不是 mexico$state.
希望对您有所帮助！
library(rgdal)
library(leaflet)
tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>Estado: </strong>",
mexico$name,
"<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>",
mexico$gdp08)
# load necessary packages
library( leaflet )
library( shiny )
library( shinydashboard )
ui <- fluidPage(
# place the contents inside a box
shinydashboard::box(
width = 12
, title = "Click on the map!"
# separate the box by a column
, column(
width = 2
, shiny::actionButton( inputId = "clearHighlight"
, icon = icon( name = "eraser")
, label = "Clear the Map"
, style = "color: #fff; background-color: #D75453; border-color: #C73232"
)
)
# separate the box by a column
, column(
width = 10
, leaflet::leafletOutput( outputId = "myMap"
, height = 850
)
)
) # end of the box
) # end of fluid page
# create the server
server <- function( input, output, session ){
# create foundational map
foundational.map <- shiny::reactive({
leaflet() %>%
#addTiles( urlTemplate = "https://cartodb-basemaps-{s}.global.ssl.fastly.net/light_all/{z}/{x}/{y}.png") %>%
#setView( lng = -87.567215
# , lat = 41.822582
# , zoom = 11 ) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons( data = mexico
, fillOpacity = 0
, opacity = 0.2
, color = "#000000"
, weight = 2
, layerId = mexico$state
, group = "click.list"
)
})
output$myMap <- renderLeaflet({
foundational.map()
})
click.list <- shiny::reactiveValues( ids = vector() )
shiny::observeEvent( input$myMap_shape_click, {
click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$state %in% click.list$ids ) , ]
print(click)
if( is.null( click$id ) ){
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
leaflet::leafletProxy( mapId = "myMap" ) %>%
addPolylines( data = lines.of.interest
, layerId = lines.of.interest@data$id
, color = "#6cb5bc"
, weight = 5
, opacity = 1
)
} # end of if else statement
}) # end of shiny::observeEvent({})
shiny::observeEvent( input$clearHighlight, {
output$myMap <- leaflet::renderLeaflet({
click.list$ids <- NULL
foundational.map()
}) # end of re-rendering $myMap
}) # end of clearHighlight action button logic
} # end of server
shiny::shinyApp( ui = ui, server = server)
我正在尝试重现这个出色的答案：
我有以下可用数据集：
library(rgdal)
library(leaflet)
tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>Estado: </strong>",
mexico$name,
"<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>",
mexico$gdp08)
在此数据之上，我构建了以下 Shiny 应用程序：
# load necessary packages
library( leaflet )
library( shiny )
library( shinydashboard )
ui <- fluidPage(
# place the contents inside a box
shinydashboard::box(
width = 12
, title = "Click on the map!"
# separate the box by a column
, column(
width = 2
, shiny::actionButton( inputId = "clearHighlight"
, icon = icon( name = "eraser")
, label = "Clear the Map"
, style = "color: #fff; background-color: #D75453; border-color: #C73232"
)
)
# separate the box by a column
, column(
width = 10
, leaflet::leafletOutput( outputId = "myMap"
, height = 850
)
)
) # end of the box
) # end of fluid page
# create the server
server <- function( input, output, session ){
# create foundational map
foundational.map <- shiny::reactive({
leaflet() %>%
#addTiles( urlTemplate = "https://cartodb-basemaps-{s}.global.ssl.fastly.net/light_all/{z}/{x}/{y}.png") %>%
#setView( lng = -87.567215
# , lat = 41.822582
# , zoom = 11 ) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons( data = mexico
, fillOpacity = 0
, opacity = 0.2
, color = "#000000"
, weight = 2
, layerId = mexico$states
, group = "click.list"
)
})
output$myMap <- renderLeaflet({
foundational.map()
})
click.list <- shiny::reactiveValues( ids = vector() )
shiny::observeEvent( input$myMap_shape_click, {
click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$states %in% click.list$ids ) , ]
if( is.null( click$id ) ){
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
leaflet::leafletProxy( mapId = "myMap" ) %>%
addPolylines( data = lines.of.interest
, layerId = lines.of.interest@data$id
, color = "#6cb5bc"
, weight = 5
, opacity = 1
)
} # end of if else statement
}) # end of shiny::observeEvent({})
shiny::observeEvent( input$clearHighlight, {
output$myMap <- leaflet::renderLeaflet({
click.list$ids <- NULL
foundational.map()
}) # end of re-rendering $myMap
}) # end of clearHighlight action button logic
} # end of server
shiny::shinyApp( ui = ui, server = server)
基本地图有效。但是，我想要实现的是，当我单击状态边界时，它会围绕该状态放置。这应该通过以下代码发生：
click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$states %in% click.list$ids ) , ]
if( is.null( click$id ) ){
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
leaflet::leafletProxy( mapId = "myMap" ) %>%
addPolylines( data = lines.of.interest
, layerId = lines.of.interest@data$id
, color = "#6cb5bc"
, weight = 5
, opacity = 1
)
}
但显然有些地方不对劲。有什么问题吗？
事实证明这个问题很容易解决（一旦你知道去哪里找）。你引用了两次 mexico$states，而它应该是 mexico$state，所以我删除了两个字母，现在它可以工作了。请参阅下面的代码。
也许添加我是如何发现这一点的也很好，这样您就知道将来如何调试类似的问题。在 observeEvent 中，我添加了 print(click)。其输出是：
$id
NULL
$.nonce
[1] 0.2851101
$group
[1] "click.list"
$lat
[1] 22.26199
$lng
[1] -100.2037
然后我们看到点击的id有问题！从那里很容易看出错误，多边形的 ids mexico$states，而不是 mexico$state.
希望对您有所帮助！
library(rgdal)
library(leaflet)
tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>Estado: </strong>",
mexico$name,
"<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>",
mexico$gdp08)
# load necessary packages
library( leaflet )
library( shiny )
library( shinydashboard )
ui <- fluidPage(
# place the contents inside a box
shinydashboard::box(
width = 12
, title = "Click on the map!"
# separate the box by a column
, column(
width = 2
, shiny::actionButton( inputId = "clearHighlight"
, icon = icon( name = "eraser")
, label = "Clear the Map"
, style = "color: #fff; background-color: #D75453; border-color: #C73232"
)
)
# separate the box by a column
, column(
width = 10
, leaflet::leafletOutput( outputId = "myMap"
, height = 850
)
)
) # end of the box
) # end of fluid page
# create the server
server <- function( input, output, session ){
# create foundational map
foundational.map <- shiny::reactive({
leaflet() %>%
#addTiles( urlTemplate = "https://cartodb-basemaps-{s}.global.ssl.fastly.net/light_all/{z}/{x}/{y}.png") %>%
#setView( lng = -87.567215
# , lat = 41.822582
# , zoom = 11 ) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons( data = mexico
, fillOpacity = 0
, opacity = 0.2
, color = "#000000"
, weight = 2
, layerId = mexico$state
, group = "click.list"
)
})
output$myMap <- renderLeaflet({
foundational.map()
})
click.list <- shiny::reactiveValues( ids = vector() )
shiny::observeEvent( input$myMap_shape_click, {
click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$state %in% click.list$ids ) , ]
print(click)
if( is.null( click$id ) ){
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
leaflet::leafletProxy( mapId = "myMap" ) %>%
addPolylines( data = lines.of.interest
, layerId = lines.of.interest@data$id
, color = "#6cb5bc"
, weight = 5
, opacity = 1
)
} # end of if else statement
}) # end of shiny::observeEvent({})
shiny::observeEvent( input$clearHighlight, {
output$myMap <- leaflet::renderLeaflet({
click.list$ids <- NULL
foundational.map()
}) # end of re-rendering $myMap
}) # end of clearHighlight action button logic
} # end of server
shiny::shinyApp( ui = ui, server = server)