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
CodePudding user response:
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)