Using the example below, I am trying to figure out a way to add functionality to my shiny app such that the following works:
Basically I'd like to be able either click on the map for a station OR input the station manually with a keyboard.
Is this possible with leaflet? I've seen references to using plotly which may be ultimate solution but I'd love to leaflet if possible in no small part because I have already done a lot of work with leaflet. This is similar to thisquestion though there is working example here:
library(shiny)
library(leaflet)
library(shinydashboard)
library(ggplot2)
library(dplyr)
data("quakes")
shinyApp(
ui = dashboardPage(title = "Station Lookup",
dashboardHeader(title = "Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Data Dashboard", tabName = "datavis", icon = icon("dashboard")),
menuItem("Select by station number", icon = icon("bar-chart-o"),
selectizeInput("stations", "Click on Station", choices = levels(factor(quakes$stations)), selected = 10, multiple = TRUE)
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "datavis",
h4("Map and Plot"),
fluidRow(box(width= 4, leafletOutput("map")),
box(width = 8, plotOutput("plot")))
)
)
)
),
server = function(input, output) {
## Sub data
quakes_sub <- reactive({
quakes[quakes$stations %in% input$stations,]
})
output$plot <- renderPlot({
ggplot(quakes_sub(), aes(x = depth, y = mag))+
geom_point()
})
output$map <- renderLeaflet({
leaflet(quakes) %>%
addTiles() %>%
addCircleMarkers(lng = ~long, lat = ~lat, layerId = ~stations, color = "blue", radius = 3) %>%
addCircles(lng = ~long, lat = ~lat, weight = 1,
radius = 1, label = ~stations,
popup = ~paste(stations, "<br>",
depth, "<br>",
mag)
)
})
}
)
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,...
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With