将 Leaflet 的图标链接到 Shiny 中的情节线图答案

【问题标题】：Linking Leaflet's icons to plotly line plot in Shiny将 Leaflet 的图标链接到 Shiny 中的情节线图
【发布时间】：2019-02-01 03:09:47
【问题描述】：

我希望将leaflet 地图上的图标链接到闪亮应用程序中plotly 线图上的对应轨迹。一旦我点击一个图标，plotly 中只会显示具有相同 id 的行。这可能吗？我一直在尝试crosstalk，但我一定错过了一些东西。

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)

【问题讨论】：

标签： r shiny leaflet plotly

【解决方案1】：

我已经编写了一个解决方案，利用它在点击时创建的传单事件。

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

为此，请阅读这些链接

参见部分：输入/事件

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

一些 SO 问题

Click event on Leaflet tile map in Shiny

R shiny: reset plot to default state

要撤消单击事件，我必须在其中添加一个重置按钮。也许有一种方法可以更优雅地撤消单击。如果您多阅读一些内容，我希望有更简洁的方法来构建它：)

干杯，强尼

【讨论】：