Turn states on a map into clickable objects in Shiny

后端 未结 1 390
傲寒
傲寒 2021-01-14 16:16

I have the following Shiny Application:

library(shiny)
library(rhandsontable)
library(shinydashboard)
library(ggplot2)
library(dplyr)



shinyApp(
  ui = das         


        
1条回答
  •  滥情空心
    2021-01-14 16:35

    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’
    

    0 讨论(0)
提交回复
热议问题