Установите один сюжетный масштаб, чтобы он соответствовал таковому другого сюжетного увеличения в Shiny - PullRequest
Новая
       19

Установите один сюжетный масштаб, чтобы он соответствовал таковому другого сюжетного увеличения в Shiny

1 голос
/ 05 февраля 2020

Я пытаюсь использовать plotly_relayout , чтобы получить пределы масштабирования по оси X одного графика и применить их к другому графику в Shiny. Пока что я могу получить соответствующие данные plotly_relayout из "plot1" (пределы оси x), преобразовать их (из числа c в дату) и получить их прямо перед построением "plot2", однако на самом деле это не так. установите масштабирование на «plot2».

В большинстве случаев мой RStudio падает, как только я пытаюсь увеличить «plot1». Лишь в небольшом числе случаев, когда RStudio не создает sh, я вижу, что "ordin_cartesian "в" plot2 "не дает желаемого эффекта (после увеличения zoom1).

Мне также довольно любопытно, если постоянный сбой моего RStudio является нормальным, учитывая приведенный ниже код, или мне, возможно, придется рассмотреть возможность перестроения RS * 1 * fre sh. Будем благодарны за любые идеи о том, как добиться этого эффекта! 

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)

1 Ответ

1 голос
/ 05 февраля 2020

На самом деле, в моей системе ваш код работает нормально.

Однако вы можете значительно сократить свой код, используя функцию subplot plotly и ее аргумент 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)

Result

...