8

Using the example below, I am trying to figure out a way to add functionality to my shiny app such that the following works:

  1. Click on a point on the map
  2. This changes the plot according to station AND
  3. Inputs the corresponding station into the "Click on Station" sidebar

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)
        )

    })

  }
)
boshek
  • 4,100
  • 1
  • 31
  • 55

1 Answers1

5

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,...

Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
  • Only issue with this approach is that the last `click` persists in the select input - as in you can clear it. It stay there until a new `station` is clicked in which case you can manually backspace it from the "Click on Station" field. Changing `selected = c(input$stations, station)` to `selected = c(station)` fixes that issue though I'm totally sure why. – boshek Jun 05 '17 at 22:07
  • Also are you suggesting you will report it and I should... happy either way. – boshek Jun 05 '17 at 22:10
  • ah didnt see that issue, let me take a look. Concerning the reporting, go ahead, as i dont require the functionality for the moment and wouldnt wait fot the updates,... – Tonio Liebrand Jun 05 '17 at 22:13
  • And of course changing `selected` means that you can't click on multiple stations at once. – boshek Jun 05 '17 at 22:29
  • Concerning your last comment, i dont really understand how clicking multiple markers would work. And i cant see it in your question to be honest,... Concerning the "deleting", that makes sense it is required. I made an edit, it will work now. – Tonio Liebrand Jun 05 '17 at 22:49
  • So valuable answer – Carlos Vecina Tebar Oct 29 '18 at 10:55
  • very glad to hear that @CarlosVecina. – Tonio Liebrand Oct 29 '18 at 21:53
  • 1
    Works great after adding adding `session` to `server <- function(input, output, session)`. Thank you! – Tung Feb 19 '21 at 23:41