r语言 - 当闪亮窗口更改/调整大小时，尝试使用facet动态更改plot plot时出错

Question

当我用参数facet_wrap绘制图表时，我试图使renderplotly高度更加动态。我想确保facet_wrap绘图不会在闪亮的应用程序中超出窗口，并且绘图彼此一样大。我想动态地做这个。有更好的方法吗?

下面是我要运行的代码:

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)

下面是我得到的错误:

二进制操作符*:非数字参数错误

Answer 1

我认为下面应该可以工作。第一个问题是，gg_facet_nrow函数在向它发送ggplotly时不起作用，因此我将ggplotly函数移动到输出$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)