Home > database >  Dynamically changing height of plotly shiny graph leads to overlapping with other uiobjects
Dynamically changing height of plotly shiny graph leads to overlapping with other uiobjects

Time:09-06

I have a shiny app with 2 graphs. The first (Plot 1) has a varying number of subplots depending on a dropdown. To keep the graph legible I need to adjust the height of the graph as a function of the number of subplots. When I increase the height of the plot, it starts to overlap the plot below (Plot 2) and sits on top of the "Plot 2" heading and disappears behind the plot below. Is there a way I can resize Plot 1 and move the rest of the elements down to accommodate it? Reprex below:

library(plotly)

ui_page <- function(){
  fluidPage(
    fluidRow(
      selectizeInput(inputId = "num_panels",
                     label = "Select Number of Subplots:",
                     choices = c(1,2,3),
                     selected = 1)
    ),
    
    h1("Plot 1"),
    plotlyOutput("plot_1"), 
    
    h1("Plot 2"),
    plotlyOutput("plot_2"),
  )
}

server_page <- function(input, output, session) {
  
  #Create Plot 1
  output$plot_1 <- renderPlotly({
    
    # Modify the dataset dependign on teh number of subplots needed
    num_panel <- as.numeric(input$num_panels)
    locs <- c("Place 1", "Place 2", "Place 3")
    df1 <- c()
    for (ii in 1:num_panel) {
      df1[[ii]] <- data.frame(location_name=locs[ii],time=c(1,2,3,4), yy=c(10,20,30,40))
    }
    df <- bind_rows(df1)
    
    TS_plot <-  ggplot(df, aes_string(x = "time", y = "yy"))  
      geom_point()  
      facet_wrap(~location_name, ncol = 1)

    fig <- ggplotly(TS_plot, height = 300*num_panel) 
  })
  
  # Create Plot 2
  output$plot_2 <- renderPlotly({
    fig <- plot_ly(
      x = c("giraffes", "orangutans", "monkeys"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar",
      height = 300)
  })
}

shinyApp(ui=ui_page, server=server_page)

Looks good with 1 subplot:

enter image description here

More subplots and it starts to overlap:

enter image description here

CodePudding user response:

Try this

library(plotly)

ui_page <- function(){
  fluidPage(
    fluidRow(
      selectizeInput(inputId = "num_panels",
                     label = "Select Number of Subplots:",
                     choices = c(1,2,3),
                     selected = 1)
    ),
    
    h1("Plot 1"), 
    uiOutput("p1"),
    
    h1("Plot 2"),
    plotlyOutput("plot_2")
  )
}

server_page <- function(input, output, session) {
  
  ht <- reactive(300*as.numeric(input$num_panels))
  
  fig1 <- eventReactive(input$num_panels, {
    # Modify the dataset dependign on teh number of subplots needed
    num_panel <- as.numeric(input$num_panels)
    locs <- c("Place 1", "Place 2", "Place 3")
    df1 <- c()
    for (ii in 1:num_panel) {
      df1[[ii]] <- data.frame(location_name=locs[ii],time=c(1,2,3,4), yy=c(10,20,30,40))
    }
    df <- bind_rows(df1)
    
    TS_plot <-  ggplot(df, aes_string(x = "time", y = "yy"))  
      geom_point()  
      facet_wrap(~location_name, ncol = 1)
    
    ggplotly(TS_plot, height = 300*num_panel) 
  })
  
  #Create Plot 1
  output$plot_1 <- renderPlotly({
    fig1()
  })
  
  output$p1 <- renderUI({
    plotlyOutput("plot_1", height=ht())
  })
  
  fig2 <-  plot_ly(
      x = c("giraffes", "orangutans", "monkeys"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar",
      height = 300)
  
  # Create Plot 2
  output$plot_2 <- renderPlotly({
    fig2
  })
}

shinyApp(ui=ui_page, server=server_page)
  • Related