将 plotly_click 应用于 shiny 应用程序中的 2 个以上图

Question

在下面的shiny应用程序中，我单击第一个折线图的一个点并将第二个折线图作为子集。 如果我选择首先单击第二个折线图，那么我将第一个折线图作为子集。

但是，如果我有第三个折线图并想应用相同的逻辑怎么办。 基本上，当我首先单击任何图表时，其他 2 应根据它进行子集化。

library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)
linedat1<-structure(list(date = structure(c(18599, 18600, 18604, 18606, 
                                  18607, 18608, 18610, 18611, 18612, 18614, 18615, 18618, 18619, 
                                  18620, 18621), class = "Date"), n_cases = c(1L, 1L, 1L, 2L, 3L, 
                                                                              1L, 2L, 3L, 4L, 1L, 2L, 4L, 2L, 1L, 2L)), row.names = c(NA, -15L
                                                                              ), class = c("tbl_df", "tbl", "data.frame"))

linedat2<-structure(list(date = structure(c(18599, 18600, 18604, 18606, 
                                            18607, 18608, 18610, 18611, 18612, 18614, 18615, 18618, 18619, 
                                            18620, 18621), class = "Date"), n_events = c(1L, 1L, 1L, 2L, 3L, 
                                                                                        1L, 2L, 3L, 4L, 1L, 2L, 4L, 2L, 1L, 2L)), row.names = c(NA, -15L
                                                                                        ), class = c("tbl_df", "tbl", "data.frame"))

linedat3<-structure(list(date = structure(c(18599, 18600, 18604, 18606, 
                                            18607, 18608, 18610, 18611, 18612, 18614, 18615, 18618, 18619, 
                                            18620, 18621), class = "Date"), n_objects = c(1L, 1L, 1L, 2L, 3L, 
                                                                                         1L, 2L, 3L, 4L, 1L, 2L, 4L, 2L, 1L, 2L)), row.names = c(NA, -15L
                                                                                         ), class = c("tbl_df", "tbl", "data.frame"))

ui <- tags$body(

  dashboardPage(
    
    # ----header----
    header = dashboardHeader(

    ), 
    
    # ----sidebar----
    sidebar = dashboardSidebar(
      

    ), 
    
    # ----body----
    body = dashboardBody(
     
      plotlyOutput("plot1"),
      plotlyOutput("plot2"),
      plotlyOutput("plot3"),

      
    )
  )
)


server <- function(input, output, session) { 
  output$plot1<-renderPlotly({
    if(is.null(myPlotEventData2())){
      p<-ggplot(data = linedat1, aes(x=date, y = n_cases)) +
        geom_area( fill="#69b3a2", alpha=0.4) +
        geom_line(color="#69b3a2", size=0.5) +
        geom_point(size=1, color="#69b3a2")+ scale_color_grey() + theme_classic()+
        labs(title="Cases per month",x="Date", y = "Cases")
      ggplotly(p,source = "myPlotSource", customdata = ~date)
    }
    else{
      linedat1<-subset(linedat1,date %in% myPlotEventData2()[1,3])
      p<-ggplot(data = linedat1, aes(x=date, y = n_cases)) +
        geom_area( fill="#69b3a2", alpha=0.4) +
        geom_line(color="#69b3a2", size=0.5) +
        geom_point(size=1, color="#69b3a2")+ scale_color_grey() + theme_classic()+
        labs(title="Cases per month",x="Date", y = "Cases")
      ggplotly(p)
    }
    
  })
  
  myPlotEventData <- reactive({
    event_data(
      event = "plotly_click",
      source = "myPlotSource")
  })
  myPlotEventData2 <- reactive({
    event_data(
      event = "plotly_click",
      source = "myPlotSource2")
  })
  output$plot2<-renderPlotly({
    if(is.null(myPlotEventData())){
      p<-ggplot(data = linedat2, aes(x=date, y = n_events)) +
        geom_area( fill="#69b3a2", alpha=0.4) +
        geom_line(color="#69b3a2", size=0.5) +
        geom_point(size=1, color="#69b3a2")+ scale_color_grey() + theme_classic()+
        labs(title="Cases per month",x="Date", y = "events")
      ggplotly(p,source = "myPlotSource2", customdata = ~date)
    }
    else{
      linedat2<-subset(linedat2,date %in% myPlotEventData()[1,3])
      p<-ggplot(data = linedat2, aes(x=date, y = n_events)) +
        geom_area( fill="#69b3a2", alpha=0.4) +
        geom_line(color="#69b3a2", size=0.5) +
        geom_point(size=1, color="#69b3a2")+ scale_color_grey() + theme_classic()+
        labs(title="Cases per month",x="Date", y = "events")
      ggplotly(p)
    }
    
  })
  output$plot3<-renderPlotly({
      p<-ggplot(data = linedat3, aes(x=date, y = n_objects)) +
        geom_area( fill="#69b3a2", alpha=0.4) +
        geom_line(color="#69b3a2", size=0.5) +
        geom_point(size=1, color="#69b3a2")+ scale_color_grey() + theme_classic()+
        labs(title="Cases per month",x="Date", y = "objects")
      ggplotly(p)
    
  })
}

shinyApp(ui, server)

Answer 1

您必须为每个 plot 创建单独的过滤数据集：

library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)

linedat1 <- structure(list(date = structure(c(18599, 18600, 18604, 18606, 
                                              18607, 18608, 18610, 18611, 18612, 18614, 18615, 18618, 18619, 
                                              18620, 18621), class = "Date"), 
                           n_cases = c(1L, 1L, 1L, 2L, 3L, 1L, 2L, 3L, 4L, 1L, 2L, 4L, 2L, 1L, 2L)),
                      row.names = c(NA, -15L), 
                      class = c("tbl_df", "tbl", "data.frame"))

linedat2 <- structure(list(date = structure(c(18599, 18600, 18604, 18606, 
                                              18607, 18608, 18610, 18611, 18612, 18614, 18615, 18618, 18619, 
                                              18620, 18621), class = "Date"), 
                           n_events = c(1L, 1L, 1L, 2L, 3L, 1L, 2L, 3L, 4L, 1L, 2L, 4L, 2L, 1L, 2L)),
                      row.names = c(NA, -15L),
                      class = c("tbl_df", "tbl", "data.frame"))

linedat3 <- structure(list(date = structure(c(18599, 18600, 18604, 18606, 
                                              18607, 18608, 18610, 18611, 18612, 18614, 18615, 18618, 18619, 
                                              18620, 18621), class = "Date"), 
                           n_objects = c(1L, 1L, 1L, 2L, 3L, 1L, 2L, 3L, 4L, 1L, 2L, 4L, 2L, 1L, 2L)),
                      row.names = c(NA, -15L),
                      class = c("tbl_df", "tbl", "data.frame"))

ui <- tags$body(
  dashboardPage(
    header = dashboardHeader(), 
    sidebar = dashboardSidebar(), 
    body = dashboardBody(
      plotlyOutput("plot1"),
      plotlyOutput("plot2"),
      plotlyOutput("plot3")
    )
  )
)

server <- function(input, output, session) {
  output$plot1 <- renderPlotly({
    if (!is.null(myPlotEventData2())) {
      displaydat1 <- subset(linedat1, date %in% myPlotEventData2()[1, 3])
    } else if (!is.null(myPlotEventData3())){
      displaydat1 <- subset(linedat1, date %in% myPlotEventData3()[1, 3])
    } else {
      displaydat1 <- linedat1
    }
    p <- ggplot(data = displaydat1, aes(x = date, y = n_cases)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
      labs(title = "Cases per month", x = "Date", y = "Cases")
    ggplotly(p, source = "myPlotSource1", customdata = ~ date)
    
  })
  
  output$plot2 <- renderPlotly({
    if (!is.null(myPlotEventData1())) {
      displaydat2 <- subset(linedat2, date %in% myPlotEventData1()[1, 3])
    } else if (!is.null(myPlotEventData3())){
      displaydat2 <- subset(linedat2, date %in% myPlotEventData3()[1, 3])
    } else {
      displaydat2 <- linedat2
    }
    p <- ggplot(data = displaydat2, aes(x = date, y = n_events)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
      labs(title = "Cases per month", x = "Date", y = "events")
    ggplotly(p, source = "myPlotSource2", customdata = ~ date)
    
  })
  
  output$plot3 <- renderPlotly({
    if (!is.null(myPlotEventData1())) {
      displaydat3 <- subset(linedat3, date %in% myPlotEventData1()[1, 3])
    } else if (!is.null(myPlotEventData2())){
      displaydat3 <- subset(linedat3, date %in% myPlotEventData2()[1, 3])
    } else {
      displaydat3 <- linedat3
    }
    p <- ggplot(data = displaydat3, aes(x = date, y = n_objects)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
      labs(title = "Cases per month", x = "Date", y = "objects")
    ggplotly(p, source = "myPlotSource3", customdata = ~ date)
  })
  
  myPlotEventData1 <- reactive({
    event_data(event = "plotly_click", source = "myPlotSource1")
  })
  
  myPlotEventData2 <- reactive({
    event_data(event = "plotly_click", source = "myPlotSource2")
  })
  
  myPlotEventData3 <- reactive({
    event_data(event = "plotly_click", source = "myPlotSource3")
  })
}

shinyApp(ui, server)

PS：在 plotly 中，您还可以跨多个绘图使用source参数 - 但在这种情况下，我们需要区分点击事件的来源。

PPS：作为重新渲染 plot 的更快替代方法，您可以使用plotlyProxy替换基础数据。 在这里你可以找到一个例子。