R Shiny: Plot with Dynamical Size

Dynamic plot height in Shiny

Use renderUI:

library(shiny)

ui <- fluidPage(
  fluidRow(
    column(
      width = 2
      , radioButtons(
          inputId = 'plotcount'
        , label   = 'Plot Count'
        , choices = as.character(1:4)
      )
    ),
    column(
      width = 10
      , uiOutput("plot.ui")
    )
  )
)

server <- function(input, output) {

  plotCount <- reactive({
    req(input$plotcount)
    as.numeric(input$plotcount)
  })

  plotHeight <- reactive(350 * plotCount())      

  output$plots <- renderPlot({

    req(plotCount())

    if (plotCount() == 0){
      plot.new()
      return()
    }

    opar <- par(mfrow = c(plotCount(), 1L))

    for (i in 1:plotCount()) {
      plot(1:100, 1:100, pch = 19)
    }

    par(opar)
  })

  output$plot.ui <- renderUI({
    plotOutput("plots", height = plotHeight())
  })

}

shinyApp(ui = ui, server = server)

shiny renderPlot with dynamic height

You can write plotOutput("plot", height = "auto") in the ui part. The default height of plotOutput are fixed 400 pixels. By setting height="auto" the plot automatically adjusts to the content.

Shiny: Dynamic height adjustment of plot

You can adjust the height in the renderPlot. I have set the minimum to 3 value box height. So, it starts increasing the height after you add 3 value boxes. You can modify it, as necessary. Try the code below.

  library(shiny)
  library(shinydashboard)
  
  ui <- dashboardPage(
    dashboardHeader(),
    
    dashboardSidebar(
      selectizeInput(
        inputId = "select",
        label = "Select country:",
        choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
        multiple = TRUE)
    ),
    
    dashboardBody(
      fluidRow(column(2, uiOutput("ui1")),
               column(10, plotOutput("some_plot"))))#,
    
    # column(4, uiOutput("ui2")),
    # column(4, uiOutput("ui3")))
  )
  
  server <- function(input, output) {
    plotht <- reactiveVal(360)
    observe({
      req(input$select)
      nvbox <- length(input$select)
      if (nvbox > 3) {
        plotheight <- 360 + (nvbox-3)*120
      }else plotheight <- 360
      plotht(plotheight)
    })
    
    output$ui1 <- renderUI({
      req(input$select)
      
      lapply(seq_along(input$select), function(i) {
        fluidRow(
          valueBox(value = input$select[i],
                   subtitle = "Box 1",
                   width = 12)
        )
      })
    })
    
    observe({
      output$some_plot <- renderPlot({
        plot(iris)
      }, height=plotht())
    })
 
    
  }
  
  shinyApp(ui = ui, server = server)

R Shiny: plot with dynamical size

You must use the inputs in the server side, for example here is one solution :

And the unit of the width and height must be a valid CSS unit, i'm not sure that "cm" is valid, use "%" or "px" (or an int, it will be coerced to a string with "px" at the end)

library(shiny)

runApp(list(
    ui = pageWithSidebar(
    headerPanel("Test"),
    sidebarPanel(
            sliderInput("width", "Plot Width (%)", min = 0, max = 100, value = 100),
            sliderInput("height", "Plot Height (px)", min = 0, max = 400, value = 400)
       ),
        mainPanel(
            uiOutput("plot.ui")
        )
    ),
    server = function(input, output, session) {

        output$plot.ui <- renderUI({
            plotOutput("plot", width = paste0(input$width, "%"), height = input$height)
        })

        output$plot <- renderPlot({
            plot(1:10)
        })
    }
))

Resize plot in Shiny dynamically

For somebody stumbling on this, here's a solution. The problem arises from the fact that Shiny has no idea that something was resized, as everything was done on the javascript level without letting Shiny know that we did resize elements. To do so, you have to explicitly call the window.resize handle via $(window).trigger('resize').

This explains by the way the behavior, why the plot gets resized properly as soon as you Inspect the element, becasue in this case the resize event is also triggered and in this routine Shiny re-scales plots apparently.

Dynamic height of shiny ggplotly plot

You can specify width/height in ggplotly() or plot_ly():

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

ui = fluidPage(
  sidebarPanel(width = 3, 
               sliderInput('count', 'count', min = 3, max = 100, value = 100, step = 25)
  ),
  mainPanel(width = 9, 
            plotlyOutput("plot"),
  )
)

server <- function(input, output, session) {
  output$plot = renderPlotly({
    d = data.frame(x = head(sentences, input$count), y = rlnorm(input$count, meanlog = 5))
    p = d %>% ggplot(aes(fct_reorder(x, y), y)) +
      geom_col(width = 0.1, col='grey90') + geom_point(size = 2) + 
      coord_flip() +
      theme_minimal(base_size = 12) + theme(panel.grid.major.y = element_blank())
    pltly = ggplotly(p, height = nrow(d) * 15) %>% layout(xaxis = list(side ="top" ))
    pltly
  })
}

shinyApp(ui = ui, server = server, options = list(launch.browser = TRUE))

However, you might want to specify a bigger minimum height, using the first option, the plot becomes quite narrow.

Using a dynamic UI to draw a 3d plot in shiny

The below works as intended.

library(shiny)
library(plotly)
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))

# Define UI 
ui<-fluidPage(
  fluidRow(
    sidebarPanel(
      selectInput("select1","Select the ID",choices = colnames(df1[,4:5]),multiple = FALSE),
      # actionButton("act1","Go"),
      uiOutput("myui"),
      # keep track of the last selection on all selectInput created dynamically
      
    ),
    mainPanel(
      #tableOutput("table1"),
      plotlyOutput("plot.3d",height = "1000px")
    )
  )
)

# Define server logic required to draw a histogram
server<-function(input,output){
  rv <- reactiveValues(mygroup=0, uitaglist = list(), uilabels = list(), input_subset = list(), plotly=NULL)
  
  observeEvent(input$select1, {
    newgroup <- unique(df1[,input$select1])
    rv$mygroup <- newgroup
    
    # ui tags
    rv$uitaglist <- list()
    for(i in 1:length(rv$mygroup)){
      rv$uitaglist[[i]]<-colourpicker::colourInput(
        inputId = paste0("ColorID",i),
        label = rv$mygroup[i])
      rv$uilabels[[i]] <- paste0("ColorID",i)
    }
   
  })
  
  output$myui <- renderUI({
    rv$input_subset <- rv$uitaglist
  })
  
  observe({
    rv$input_subset <- lapply(rv$uilabels, function(x) input[[x]])
    p<-plot_ly()
    for(i in 1:length(rv$mygroup)) {

      df2<-df1[df1$ID2 == rv$mygroup[i],] %>% select(a,b,c)
      p<-add_trace(p=p,
                   data = df2,
                   x=~a,y=~b,z=~c,
                   type="scatter3d",
                   marker = list(size=5,color=rv$input_subset[[i]]),
                   mode="markers"
      )
    }
    rv$plotly <- p
  })

  output$plot.3d<-renderPlotly({
    rv$plotly
  })
} # end server

# Run the application 
shinyApp(ui = ui, server = server)

The main difficulty was to observe all your dynamically-generated UI inputs at once. Turns out it could be done using observe and lapply.

Observing several inputs is problematic because the error Must use single string to index into reactivevalues is returned by trying to index input by a vector or list.

Now, Why this can't be done out-of-the-box is a good question.

Dynamic number of Plots with reactive data in R Shiny

The following code generates dynamic number of outputs with iris data. You should be able to adapt this to your data.

  library(shiny)
  library(tidyverse)

  # Load data
  data("iris")

  # Add row id
  iris2 <- iris %>% mutate(ID = 1:n())

  # ui
  ui <- fluidPage(
    sidebarPanel(
      selectInput(inputId = "sel", label = "Select one or more parameters",
                  choices = names(iris2), multiple = TRUE)
    ),
    mainPanel(
      uiOutput("plots")
    )
  )

  # server
  server <- function(input, output, session){

    # Dynamically generate the plots based on the selected parameters
    observe({
      req(input$sel)
      lapply(input$sel, function(par){
        p <- ggplot(iris2, aes_string(x = "ID", y = par)) +
          geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
          ggtitle(paste("Plot: ", par)) 
        output[[paste("plot", par, sep = "_")]] <- renderPlot({
          p
        },
        width = 380,
        height = 350)
      })
    })

    # Create plot tag list
    output$plots <- renderUI({
      req(input$sel)
      plot_output_list <- lapply(input$sel, function(par) {
        plotname <- paste("plot", par, sep = "_")
        plotOutput(plotname, height = '250px', inline=TRUE)
      })

      do.call(tagList, plot_output_list)

    })

  }

  shinyApp(ui, server)

It gives the following output:

---

Related Topics