问题
I have the following Shiny Application:
library(shiny)
library(rhandsontable)
library(shinydashboard)
library(ggplot2)
library(dplyr)
shinyApp(
ui = dashboardPage(
dashboardHeader(
title = "Tweetminer",
titleWidth = 350
),
dashboardSidebar(
width = 350,
sidebarMenu(
menuItem("Menu Item")
)
),
dashboardBody(
fluidRow(
tabBox(
tabPanel("Set tweets2",
plotOutput('plot',
brush = brushOpts(
id = "plot1_brush"
)),
h4("Selected States"),
verbatimTextOutput("select_states"),
h4("Selected States' Tweets"),
verbatimTextOutput("tweets"),
h4("Selected States' Amount"),
textOutput("test1")#,
#actionButton("button", textOutput("test1"))
)
)
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
all_states <- map_data("state")
states_positive <- c("louisiana", "alaska", "new york")
# Plot results
ggplot(all_states, aes(x=long, y=lat, group = group)) +
geom_polygon(fill="grey", colour = "white") +
geom_polygon(fill="orange", data = filter(all_states, region %in% states_positive))
})
})
This works. However I would like to include the functionality to click on a state and then get a pop up bar. I know how to do it click brush but there you often select multiple states. Any thoughts on how I can turn the states into clickable objects?
回答1:
Overview
Use shiny::observeEvent( input$outputId_shape_click, {foo}) to monitor the leaflet map whenever a click occurs on a polygon. Then, store the list of clicked polygons as a reactive value to perform actions based on the polygon(s) in that list.
I called that object click.list, which was used to filter comarea606 - the spatial polygon data frame - by those polygons stored in click.list. You would then go onto use that filtered data to perform subsequent operations.
Reproducible Example
This Shiny app displays a leaflet map of the City of Chicago's 77 community areas (i.e. neighborhoods). When the user clicks on a particular community area, that polygon's border changes color. The Clear the Map button re-renders the leaflet map to take away the polygons that the user highlighted when clicking.
# install necessary packages
install.packages( pkgs = c( "devtools", "shiny", "shinydashboard" ) )
# install the development version of leaflet from Github
devtools::install_github( repo = "rstudio/leaflet" )
# load necessary packages
library( leaflet )
library( shiny )
library( shinydashboard )
# import City of Chicago current community area boundaries
comarea606 <- readRDS( gzcon( url( description = "https://github.com/cenuno/shiny/raw/master/cps_locator/Data/raw-data/comarea606_raw.RDS" ) ) )
# Note: for speed, I loaded the GeoJSON file from the City's
# data portal and exported the object as an RDS file in another script.
# To download the raw data yourself, feel free to run this:
# install.packages( pkgs = c( "sp", "rgdal" ) )
# comarea606 <-
# rgdal::readOGR( dsn = "https://data.cityofchicago.org/api/geospatial/cauq-8yn6?method=export&format=GEOJSON"
# , layer = "OGRGeoJSON"
# , stringsAsFactors = FALSE
# )
# create the UI
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 ) %>%
addPolygons( data = comarea606
, fillOpacity = 0
, opacity = 0.2
, color = "#000000"
, weight = 2
, layerId = comarea606$community
, group = "click.list"
)
})
output$myMap <- renderLeaflet({
foundational.map()
}) # end of leaflet::renderLeaflet({})
# store the list of clicked polygons in a vector
click.list <- shiny::reactiveValues( ids = vector() )
# observe where the user clicks on the leaflet map
# during the Shiny app session
# Courtesy of two articles:
# https://stackoverflow.com/questions/45953741/select-and-deselect-polylines-in-shiny-leaflet
# https://rstudio.github.io/leaflet/shiny.html
shiny::observeEvent( input$myMap_shape_click, {
# store the click(s) over time
click <- input$myMap_shape_click
# store the polygon ids which are being clicked
click.list$ids <- c( click.list$ids, click$id )
# filter the spatial data frame
# by only including polygons
# which are stored in the click.list$ids object
lines.of.interest <- comarea606[ which( comarea606$community %in% click.list$ids ) , ]
# if statement
if( is.null( click$id ) ){
# check for required values, if true, then the issue
# is "silent". See more at: ?req
req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
# call the leaflet proxy
leaflet::leafletProxy( mapId = "myMap" ) %>%
# and add the polygon lines
# using the data stored from the lines.of.interest object
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({})
# Create the logic for the "Clear the map" action button
# which will clear the map of all user-created highlights
# and display a clean version of the leaflet map
shiny::observeEvent( input$clearHighlight, {
# recreate $myMap
output$myMap <- leaflet::renderLeaflet({
# first
# set the reactive value of click.list$ids to NULL
click.list$ids <- NULL
# second
# recall the foundational.map() object
foundational.map()
}) # end of re-rendering $myMap
}) # end of clearHighlight action button logic
} # end of server
## run shinyApp ##
shiny::shinyApp( ui = ui, server = server)
# end of script #
References
Select and Deselect Polylines in Shiny/Leaflet and the Inputs/Events section of the Using Leaflet with Shiny page within the Leaflet for R website were helpful in producing this example.
Session Info
R version 3.4.3 (2017-11-30)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS Sierra 10.12.6
Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] leaflet_1.1.0.9000 shinydashboard_0.6.1 shiny_1.0.5
loaded via a namespace (and not attached):
[1] htmlwidgets_1.0 compiler_3.4.3 magrittr_1.5 R6_2.2.2
[5] htmltools_0.3.6 tools_3.4.3 yaml_2.1.16 Rcpp_0.12.15
[9] crosstalk_1.0.0 digest_0.6.14 xtable_1.8-2 httpuv_1.3.5
[13] mime_0.5
RStudio Version
$citation
To cite RStudio in publications use:
RStudio Team (2016). RStudio: Integrated Development for R. RStudio,
Inc., Boston, MA URL http://www.rstudio.com/.
A BibTeX entry for LaTeX users is
@Manual{,
title = {RStudio: Integrated Development Environment for R},
author = {{RStudio Team}},
organization = {RStudio, Inc.},
address = {Boston, MA},
year = {2016},
url = {http://www.rstudio.com/},
}
$mode
[1] "desktop"
$version
[1] ‘1.1.414’
来源：https://stackoverflow.com/questions/48432061/turn-states-on-a-map-into-clickable-objects-in-shiny