将地图上的状态转换为Shiny中的可点击对象

时间:2018-01-24 21:41:05

标签: r shiny shinydashboard

我有以下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)) 

    })

  })

这很有效。但是,我希望包含单击状态的功能,然后获得弹出栏。我知道如何点击刷子,但你经常选择多个状态。关于如何将状态转换为可点击对象的任何想法?

1 个答案:

答案 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以及 Leaflet for Riny中的使用Leaflet with Shiny页面的Inputs/Events部分有助于制作此示例。

会话信息

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版本

$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’