1

I would like the icons on a leaflet map to be linked to the correspondent trace on a plotly line plot in a shiny app. Once I click on an icon, only the line with the same id should be displayed in plotly. Is this possible? I have been trying with crosstalk but I must be missing something.

library(shiny)
library(leaflet)
library(plotly)
library(crosstalk)


tmp1 <- data.frame(Date = seq(as.POSIXct("2016-06-18 10:00"),
                              length.out = 10, by = "mins"),
                   Temp = rnorm(n = 10, mean = 20, sd = 5),
                   lat=51.504162, 
                   long=-0.130472,
                   id="first") 
tmp2 <- data.frame(Date = seq(as.POSIXct("2016-06-18 10:00"),
                              length.out = 10, by = "mins"),
                   Temp = rnorm(n = 10, mean = 20, sd = 5),
                   lat=51.502858,
                   long= -0.116722,
                   id="second") 

uktemp<-rbind(tmp1,tmp2)

#=========================================

ui <- fluidPage(
  fluidRow(
    column(6, leafletOutput("map")),
    column(6, plotlyOutput("graph"))
  )
)

server <- function(input, output, session) {
  crossuktemp<- SharedData$new(uktemp)

  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 15,maxZoom =18 ))%>%
      addTiles()%>%
      addCircles(data=crossuktemp,
                 lng= ~ long,
                 lat= ~ lat,
                 label=~id)
  })

  output$graph <- renderPlotly({
    plot_ly(crossuktemp,x=~Date,y=~Temp, color =~id, mode="lines")%>%
      layout(title = "",yaxis = list(title = "C°"), 
             xaxis = list(title = "Time")) %>%
      highlight(off = "plotly_deselect") 
  })
}

shinyApp(ui, server)

1 Answers1

3

I've hacked together a solution, making use of leaflets events it creates on the click.

ui <- fluidPage(
  # add a reset button to undo click event
  fluidRow(actionButton("reset", "Reset")),
  fluidRow(
    column(6, leafletOutput("map")),
    column(6, plotlyOutput("graph"))
  ),
  fluidRow()
)

server <- function(input, output, session) {
  
  # create reactive data set based on map click
  filteredData <- reactive({
    event <- input$map_shape_click
    if (!is.null(event)){
      uktemp[uktemp$lat == event$lat & uktemp$long == event$lng,]
    }
  })
  
  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 15,maxZoom =18 ))%>%
      addTiles()%>%
      addCircles(data=uktemp,
                 lng= ~ long,
                 lat= ~ lat,
                 label=~id)
  })

  
  # default graph
  output$graph <- renderPlotly({
    plot_ly(uktemp,x=~Date,y=~Temp, color =~id, mode="lines")%>%
      layout(title = "",yaxis = list(title = "C°"), 
             xaxis = list(title = "Time")) %>%
      highlight(off = "plotly_deselect") 
  })
  
  # if clicked on map, use filtered data
  observeEvent(input$map_click,
               output$graph <- renderPlotly({
                 plot_ly(filteredData(),x=~Date,y=~Temp, color =~id, mode="lines")%>%
                   layout(title = "",yaxis = list(title = "C°"), 
                          xaxis = list(title = "Time")) %>%
                   highlight(off = "plotly_deselect") 
               })
  )
  
  # if reset, then go back to main data
  observeEvent(input$reset,
               
               output$graph <- renderPlotly({
                 plot_ly(uktemp,x=~Date,y=~Temp, color =~id, mode="lines")%>%
                   layout(title = "",yaxis = list(title = "C°"), 
                          xaxis = list(title = "Time")) %>%
                   highlight(off = "plotly_deselect") 
               })
               
  )
  
}

To do so, have a read of these links

see the section: Inputs/Events

https://rstudio.github.io/leaflet/shiny.html

some SO questions

Click event on Leaflet tile map in Shiny

R shiny: reset plot to default state

To do undo the click event, I had to add a reset button in. Maybe there is a way of undoing a click in a more elegant way. I expect there are cleaner ways to build this if you read around it some more :)

Cheers, Jonny

Rich Pauloo
  • 7,734
  • 4
  • 37
  • 69
Jonny Phelps
  • 2,687
  • 1
  • 11
  • 20