Click on Points in a Leaflet Map as Input for a Plot in Shiny

Click on points in a leaflet map as input for a plot in shiny

You can use input$map_marker_click and updateSelectInput():

Edit: Added functionality that stations can be deleted from selectInput() as suggested by OP in the comments.

(Dont forget to add session to your sever function).

observeEvent(input$stations,{
updateSelectInput(session, "stations", "Click on Station",
choices = levels(factor(quakes$stations)),
selected = c(input$stations))
})

observeEvent(input$map_marker_click, {
click <- input$map_marker_click
station <- quakes[which(quakes$lat == click$lat & quakes$long == click$lng), ]$stations
updateSelectInput(session, "stations", "Click on Station",
choices = levels(factor(quakes$stations)),
selected = c(input$stations, station))
})

However, this functionality is partly overwritten by the popup event(?). As i see it there is an inner blue circle (darker blue) that if clicked produces the popup. However, the input$map_marker_click only works if you click the outer (light blue) circle. I would report it as a bug,...

Click on points on Leaflet map to generate ggplot in Shiny

Here's a solution:

library(leaflet)
library(shiny)
library(ggplot2)

# example data frame
wxstn_df <- data.frame(Site = c("a", "a", "b"), Latitude = c(44.1, 44.1, 37), Longitude = c(-110.2, -110.2, -112.7), Month = c(1,2,1), Temp_avg = c(10, 18, 12))

ui <- fluidPage(column(7, leafletOutput("wsmap", height = "600px")),
column(5, plotOutput("plot", height = "600px"))
)

server <- function(input, output) {

## leaflet map
output$wsmap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addCircleMarkers(data = wxstn_df, ~unique(Longitude), ~unique(Latitude), layerId = ~unique(Site), popup = ~unique(Site))
})

# generate data in reactive
ggplot_data <- reactive({
site <- input$wsmap_marker_click$id
wxstn_df[wxstn_df$Site %in% site,]
})

output$plot <- renderPlot({
ggplot(data = ggplot_data(), aes(Month, Temp_avg)) +
geom_line()
})
}

shinyApp(ui, server)

The main problem is that you were not changing the object names from the example that you were using, e.g. input$wsmap_marker_click because wsmap is the name of you leaflet ID. Similarly, to access Site info, use input$wsmap_marker_click$id not input$wsmap_marker_click$Site. It is often useful to print the objects within the reactive function to explore what the input object looks like and how to access parts of it.

e.g.

   # generate data in reactive
ggplot_data <- reactive({
print(input$wsmap_marker_click)
site <- input$wsmap_marker_click$id
print(site)

data <- wxstn_df[wxstn_df$Site %in% site,]
print(data)
data})

Personally in this situation I would prefer to use a reactive expression generate ggplot data (ggplot_data()) from marker click rather than creating a reactiveValues object. Every time the marker is clicked the plot will update with new ggplot_data().

And proof it works:

Sample Image

How to connect leaflet map clicks (events) with plot creation in a shiny app

Here is a minimal example. You click on your marker and you get a plot.

ui = fluidPage(
leafletOutput("map"),
textOutput("temp"),
plotOutput('tim')
)

#server.r

#df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {

output$map <- renderLeaflet({
leaflet(df)%>% addTiles() %>% addMarkers(lng = longitude, lat = latitude)
})

output$temp <- renderPrint({

input$map_marker_click$lng
})

output$tim <- renderPlot({
temp <- df %>% filter(longitude == input$map_marker_click$lng)
# timeVariation(temp, pollutant = "value")
print(ggplot(data = temp, aes(longitude, latitude)) + geom_point())
})

}

shinyApp(ui = ui, server = server)

Adding reactive popup graphs/plots to a Leaflet map with Shiny R

If I understood correctly:

library(sf)
library(dplyr)
library(shiny)
library(shinydashboard)
library(leaflet)
library(leafpop)
library(ggplot2)
library(reshape2)

set.seed(1)

# Let's use this municipality in the example
inputMunicipality = "Landgraaf"

# Download municipality geometry
df <-st_read(URLencode(sprintf("https://geo.leefbaarometer.nl/leefbaarometer/wfs?version=1.0.0&cql_filter=gemeente=%s%s%s&request=GetFeature&typeName=leefbaarometer:wijken_2018&srsName=epsg:4326&outputFormat=json",
"'", inputMunicipality, "'")))[c("WK_NAAM", "WK_CODE")]
# Add some fake scores
df$environmentScore <- sample(10, size = nrow(df), replace = TRUE)
df$facilitiesScore <- sample(10, size = nrow(df), replace = TRUE)
df$housingScore <- sample(10, size = nrow(df), replace = TRUE)
df$safetyScore <- sample(10, size = nrow(df), replace = TRUE)

# Define dashboard UI
ui <- dashboardPage(
dashboardHeader(title = "Testing reactive popup on click event!"),
dashboardSidebar(),
dashboardBody(
fluidRow(leafletOutput("myMap")
)
)
)

# Define server logic
server <- function(input, output) {

# Function for generation a popup based on the area clicked by the user
makePopupPlot <- function (clickedArea, df) {
# prepare the df for ggplot
noGeom <- st_drop_geometry(df)
plotData <- noGeom[c("WK_NAAM", "environmentScore", "facilitiesScore","housingScore", "safetyScore")]
plotDataSubset <- subset(plotData, plotData['WK_NAAM'] == clickedArea)
plotDataMelt = melt(plotDataSubset, id.vars = "WK_NAAM")

popupPlot <- ggplot(data = plotDataMelt, aes(x = variable, y = value, fill=value)) +
geom_bar(position="stack", stat="identity", width = 0.9) +
scale_fill_steps2(
low = "#ff0000",
mid = "#fff2cc",
high = "#70ad47",
midpoint = 5) +
coord_flip() +
ggtitle(paste0("Score overview in ", clickedArea)) +
theme(legend.position = "none") +
theme(plot.margin = unit(c(0,0.5,0,0), "cm"), plot.title = element_text(size = 10))

return (popupPlot)
}

# chart list
p <- as.list(NULL)
p <- lapply(1:nrow(df), function(i) {
p[[i]] <- makePopupPlot(df$WK_NAAM[i], df)
})

output$myMap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$nlmaps.grijs) %>%
addPolygons(data = df, popup = popupGraph(p, type = "svg"))
})
}

# Run the application
shinyApp(ui = ui, server = server)

Turn states on a map into clickable objects in Shiny

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’


Related Topics



Leave a reply



Submit