在 Shiny 中设置一个绘图缩放以匹配另一个绘图缩放
Set one plotly zoom to match that of another plotly zoom in Shiny
我正在尝试使用 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)
实际上,您的代码在我的系统上运行良好。
但是,您可以通过使用 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)
我正在尝试使用 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)
实际上,您的代码在我的系统上运行良好。
但是,您可以通过使用 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)