Question

我希望将leaflet地图上的图标链接到闪亮的应用程序中plotly线图中的对应迹线。单击图标后，只有具有相同 id 的行应显示在plotly中。这可能吗？我一直在尝试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)

Answer 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=crossuktemp,
                 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

要撤消click事件，我必须在其中添加一个重置按钮。也许有一种更优雅的方式来撤消click。我希望如果您进一步阅读它，可以找到一些更干净的方法来构建它：）

干杯，强尼

将Leaflet的图标链接到Shiny中的绘图线图

1 个答案: