在Shiny中设置一个绘图缩放以匹配另一个绘图缩放

Question

我正在尝试使用plotly_relayout来获取一个绘图的x轴缩放限制，并将其应用于Shiny中的另一个绘图。到目前为止，我可以从“ plot1”（x轴限制）获取相关的plotly_relayout数据，将其转换（从数字到日期），并在绘制“ plot2”之前将其可用，但是实际上并没有设置缩放比例“ plot2”上的范围。

[在大多数情况下，当我尝试放大“ plot1”时，RStudio崩溃。仅在少数几个RStudio不会崩溃的情况下，我才能看到“ plot2”中的“ coord_cartesian”没有达到预期的效果（在对plot1进行放大之后）。

我也很好奇，如果给定以下代码，RStudio的持续崩溃是否正常，或者我可能需要考虑重新构建RStudio。任何有关如何实现这种效果的想法将不胜感激！

library(ggplot2)
library(plotly)
library(shinydashboard)
library(shinyWidgets)

#Data frame with dates and bogus data
a=data.frame(Date=seq.Date(as.Date("2000-01-01"),
                           as.Date("2000-12-31"),
                           "day"),
             value=rnorm(366)
             )

#Simple dashboard with two plots
ui <- dashboardPage(
  dashboardHeader(title="Sample App"),
  dashboardSidebar(
  ),
  dashboardBody(
    plotlyOutput("plot1"),
    plotlyOutput("plot2")
  )
)

server <- function(input, output, session){

  #Create a reactive list, set zoomX1 and zoomX2 as NULL
  reactiveList <- reactiveValues(zoomX1=NULL,zoomX2=NULL)

  #Create a reactive function to update the reactive list every time the plotly_relayout changes
  relayout_data <- reactive({
    xvals=event_data("plotly_relayout",source="plot1")
    if (is.null(xvals$`xaxis.range[0]`)){
    } else {
      reactiveList$zoomX1=as.Date(xvals$`xaxis.range[0]`,origin="1970-01-01")
      reactiveList$zoomX2=as.Date(xvals$`xaxis.range[1]`,origin="1970-01-01")
    }
  })

  #Plot1, just plot all the data
   output$plot1 <- renderPlotly({
    g1=ggplot(a,aes(x=Date,y=value))+
      geom_point()
    ggplotly(g1,source="plot1") %>% event_register("plotly_relayout")
  })

   #Plot 2, same as Plot1, but should set the coord_cartesian based on plot1's current zoom level taken from the event_data("plotly_relayout")
   output$plot2 <- renderPlotly({
     relayout_data()
     g1=ggplot(a,aes(x=Date,y=value))+
       geom_point()+
       coord_cartesian(xlim=c(reactiveList$zoomX1,reactiveList$zoomX2))
     ggplotly(g1,source="plot2")
   })

}

shinyApp(ui = ui, server = server)

Answer 1

实际上，在我的系统上，您的代码运行正常。

但是，您可以通过使用plotly的subplot函数及其参数shareX来大幅度减少代码。请检查以下示例：

library(ggplot2)
library(plotly)
library(shinydashboard)
library(shinyWidgets)

a <- data.frame(Date = seq.Date(as.Date("2000-01-01"),
                               as.Date("2000-12-31"),
                               "day"),
               value = rnorm(366))

ui <- dashboardPage(
  dashboardHeader(title = "Sample App"),
  dashboardSidebar(),
  dashboardBody(plotlyOutput("plots", height = "80vh"))
)

server <- function(input, output, session) {

  output$plots <- renderPlotly({
    g2 <- g1 <- ggplot(a, aes(x = Date, y = value)) +
      geom_point()

    subplot(ggplotly(g1), ggplotly(g2), nrows = 2, shareX = TRUE)
  })

}

shinyApp(ui = ui, server = server)