尝试在闪亮时使用构面动态更改 plotly plot 时出错 window changes/resizes

Error when trying to dynamically change a plotly plot using facets when shiny window changes/resizes

我试图在绘制带有参数 facet_wrap 的图表时使 rendPlotly 高度更加动态。我想确保 facet_wrap 图不会超过 shiny 应用程序中的 window 并且这些图彼此一样大。我想动态地做到这一点。有更好的方法吗?

这是我正在尝试的代码 运行:

library(ggplot2)
library(shiny)
library(tidyverse)
library(plotly)

mtcars$cyl = sample(letters[1:5], 32, TRUE)

library(magrittr)
gg_facet_nrow <- function(p){
  num_panels <- length(unique(ggplot_build(p)$data[[1]]$PANEL)) # get number of panels
  num_cols <- ggplot_build(p)$layout$facet$params$ncol # get number of columns set by user
  num_rows <- wrap_dims(num_panels, ncol=num_cols)[1] # determine number of rows
}

ui <- fluidPage(
  navbarPage(title="title",
             tabPanel("One", 
                      column(3, 
                             wellPanel( selectInput('name', 'NAME', c("A", "B")))),
                      column(9, plotOutput('plot1')))
  ))


server <- function(input, output) {
  
  X <- reactive({input$name == "A"})
  
  p1 <- reactive({
    if(X()){
      p1 <- ggplotly(ggplot(mtcars, aes(mpg, wt)) + facet_wrap( . ~ gear, ncol = 1 ), height = function(){he()*300})
    }else{
      p1 <- ggplotly(ggplot(mtcars, aes(mpg, wt)) + facet_wrap( cyl  ~ gear, ncol = 1 ),  height = function(){he()*300})
    } 
    return(p1)
  })
  
  he <- reactive(gg_facet_nrow(p1()))
  
  output$plot1 <- renderPlotly({p1()})
}

shinyApp(ui,server)

这是我得到的错误:

Error in *: non-numeric argument to binary operator

我认为下面应该可行。第一个问题是 gg_facet_nrow 函数对我来说在发送 ggplotly 时不起作用,所以我将 ggplotly 函数移动到 output$plot1。其次,在 UI 中它有 plotOutput,我将其切换为 plotlyOutput。最后,高度函数似乎不像 height = function(){he()*300} 那样工作,所以我删除了函数项使其成为 height = he()*300

library(ggplot2)
library(shiny)
library(tidyverse)
library(plotly)

mtcars$cyl = sample(letters[1:5], 32, TRUE)

library(magrittr)
gg_facet_nrow <- function(p){
  num_panels <- length(unique(ggplot_build(p)$data[[1]]$PANEL)) # get number of panels
  num_cols <- ggplot_build(p)$layout$facet$params$ncol # get number of columns set by user
  num_rows <- wrap_dims(num_panels, ncol=num_cols)[1] # determine number of rows
}

ui <- fluidPage(
  navbarPage(title="title",
             tabPanel("One", 
                      column(3, 
                             wellPanel( selectInput('name', 'NAME', c("A", "B")))),
                      column(9, plotlyOutput('plot1'))) #Changed to plotlyOutput
  ))


server <- function(input, output) {
  
  X <- reactive({input$name == "A"})
  
  p1 <- reactive({
    if(X()){
      p1 <- ggplot(mtcars, aes(mpg, wt)) + facet_wrap( . ~ gear, ncol = 1 ) #Removed ggplotly wrapper and height function
    }else{
      p1 <- ggplot(mtcars, aes(mpg, wt)) + facet_wrap( cyl  ~ gear, ncol = 1 ) #Removed ggplotly wrapper and height function
    } 
    return(p1)
  })
  
  he <- reactive(gg_facet_nrow(p1()))
  
  output$plot1 <- renderPlotly({ggplotly(p1(), height = he()*300)}) #removed the function term around the he*300
}

shinyApp(ui,server)