Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Turn states on a map into clickable objects in Shiny

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?

like image 934
Henk Straten Avatar asked Dec 24 '22 10:12

Henk Straten


1 Answers

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’
like image 134
Cristian E. Nuno Avatar answered Jan 12 '23 18:01

Cristian E. Nuno