我有以下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))
})
})
这很有效。但是，我希望包含单击状态的功能，然后获得弹出栏。我知道如何点击刷子，但你经常选择多个状态。关于如何将状态转换为可点击对象的任何想法？
答案 0 :(得分：6)
只要在多边形上发生单击，就使用shiny::observeEvent( input$outputId_shape_click, {foo})监控传单地图。然后，将单击的多边形列表存储为反应值，以根据该列表中的多边形执行操作。
我通过click.list中存储的那些多边形调用了对象comarea606，用于过滤click.list - 空间多边形数据框。然后，您将继续使用过滤后的数据来执行后续操作。
这个Shiny应用程序显示City of Chicago's 77 community areas（即邻域）的传单地图。当用户点击特定社区区域时，该多边形的边框会改变颜色。 “清除地图”按钮会重新呈现传单地图，以删除用户在单击时突出显示的多边形。
# 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 #
Select and Deselect Polylines in Shiny/Leaflet以及
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
$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’