当闪亮的窗口更改/调整大小时，尝试使用分面动态更改绘图时出错

Question

I'm trying to make the rendPlotly height more dynamic when I plot a chart with the argument facet_wrap. I want to ensure that the facet_wrap plot doesn't go over the window in the shiny application and that the plots are equally as large as each other. I want to do this dynamically. Is there a better way to do this?

Here is the code I'm trying to run:

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)

Here is the error I get:

Error in *: non-numeric argument to binary operator

Answer 1

I think below should work. The first issue is that the gg_facet_nrow function for me doesn't work when sending it a ggplotly, so I moved the ggplotly function to output$plot1. Second, in the UI it had plotOutput, which I switched for plotlyOutput. And lastly, the height function didn't seem to work as height = function(){he()*300} , so I removed the function terms to make it 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)