r - 在 R Shiny 中调整 Plotly::subplot 的高度和宽度

Question

我正在尝试plotly::subplot在shiny应用程序中插入R. app按预期工作，除了subplot即使在.heightwidthrenderPlotly

如何调整子图的高度和宽度R Shiny？

我能找到的与此问题相似的最接近的答案使用户选择所需的高度和宽度，这不是我想要的，因为我想在代码中预定义绘图大小。

代码

    library(shiny)
    library(shinydashboard)
    library(shinythemes)
    library(shinyWidgets)
    library(fontawesome)
    library(tidyverse)
    library(plotly)
    
    # Define UI for application that draws a plotlys
    options(shiny.maxRequestSize=30*1024^2)
    ui =   navbarPage("Title", theme = shinytheme("spacelab"),
                      tabPanel("Interactive Plot",
                               icon = icon("chart-area"),
                               # Show plots side by side
                               splitLayout(
                                   plotlyOutput(outputId = "Comparison_Plots"),
                                   width = "1080px",
                                   height = "1280px")))
    
    # Tell the server how to assemble inputs into outputs
    server = function(input, output) {
    
        output$Comparison_Plots = renderPlotly({
    
    Group_1_2020 = data.frame(Code = c("A", "B", "C", "AA", "AAA", "AAAA", "BB", "BBB", "BBBB", "CC", "CCC", "CCCC"),
                     Count_2020 = c(1,2,3,11,111,121,22,222,263,33,333,363))
    
    Group_2_2020 = data.frame(Code = c("D", "E", "F", "DD", "DDD", "DDDD", "EE", "EEE", "EEEE", "FF", "FFF", "FFFF"),
                              Count_2020 = c(4,5,6,14,24,34,45,55,65,76,86,96))
    
    Group_1_2021 = data.frame(Code = c("A", "B", "C", "AA", "AAA", "AAAA", "BB", "BBB", "BBBB", "CC", "CCC", "CCCC"),
                     Count_2021 = c(4, 8, 6,14,116,128,42,242,263,43,433,863 ))
    Group_2_2021 = data.frame(Code = c("D", "E", "F","DD", "DDD", "DDDD", "EE", "EEE", "EEEE", "FF", "FFF", "FFFF"),
                              Count_2021 = c(8, 10, 12,44,64,85,105,125,96,46,136))
    
    # Merge Datasets
    DF_Merged_1 = 
      inner_join(Group_1_2020, Group_1_2021)
    
    DFF_Merged_1 = DF_Merged_1 %>% dplyr::select(Code, Count_2020, Count_2021) %>% 
      gather(key = Type, value = Value, -Code) %>% 
      mutate(Type = ifelse(Type == "Count_2020", "2020", "2021"))
    
    DF_Merged_2 = 
      inner_join(Group_2_2020, Group_2_2021)
    
    DFF_Merged_2 = DF_Merged_2 %>% dplyr::select(Code, Count_2020, Count_2021) %>% 
      gather(key = Type, value = Value, -Code) %>% 
      mutate(Type = ifelse(Type == "Count_2020", "2020", "2021"))
    
    
    # ggplot
    ggplot_1 = DFF_Merged_1 %>% 
      ggplot(aes(x = reorder(Code,Value), y = Value, fill = Type, 
                 text = paste("Count:", Value,
                              "<br>", "Offense Code:", Code,
                              "<br>", "Year:", Type))) +
      geom_col(position = "dodge", show.legend = FALSE) +
      xlab("Offense Code") +
      ylab("Count") +
      ggtitle("Group 1 in Year 2020 and  2021") +
      theme(axis.text=element_text(size=8)) 
    
    ggplot_2 = DFF_Merged_2 %>% 
      ggplot(aes(x = reorder(Code,Value), y = Value, fill = Type, 
                 text = paste("Count:", Value,
                              "<br>", "Offense Code:", Code,
                              "<br>", "Year:", Type))) +
      geom_col(position = "dodge", show.legend = FALSE) +
      xlab("Offense Code") +
      ylab("Count") +
      ggtitle("Group 2 in Year 2020 and  2021") +
      theme(axis.text=element_text(size=8)) 
    
    # Interactive Plots
    fig1 = ggplotly(ggplot_1, tooltip = "text")  
    fig2 = ggplotly(ggplot_2, tooltip = "text")  
    subplot(fig1, fig2)
    
    })
      }
# Run the application 
shinyApp(ui = ui, server = server)

原始数据的快照以显示问题

标签： rshinyplotly

Answer 1

height和width参数是你的plotlyOutput传递它 o splitLayout。

尝试 -

library(shiny)
library(shinydashboard)
library(shinythemes)
library(shinyWidgets)
library(fontawesome)
library(tidyverse)
library(plotly)

ui =   navbarPage("Title", theme = shinytheme("spacelab"),
                  tabPanel("Interactive Plot",
                           icon = icon("chart-area"),
                           # Show plots side by side
                           
                             plotlyOutput(outputId = "Comparison_Plots",
                             width = "1080px",
                             height = "1280px")))

# Tell the server how to assemble inputs into outputs
server = function(input, output) {
  
  output$Comparison_Plots = renderPlotly({
    
    Group_1_2020 = data.frame(Code = c("A", "B", "C", "AA", "AAA", "AAAA", "BB", "BBB", "BBBB", "CC", "CCC", "CCCC"),
                              Count_2020 = c(1,2,3,11,111,121,22,222,263,33,333,363))
    
    Group_2_2020 = data.frame(Code = c("D", "E", "F", "DD", "DDD", "DDDD", "EE", "EEE", "EEEE", "FF", "FFF", "FFFF"),
                              Count_2020 = c(4,5,6,14,24,34,45,55,65,76,86,96))
    
    Group_1_2021 = data.frame(Code = c("A", "B", "C", "AA", "AAA", "AAAA", "BB", "BBB", "BBBB", "CC", "CCC", "CCCC"),
                              Count_2021 = c(4, 8, 6,14,116,128,42,242,263,43,433,863 ))
    Group_2_2021 = data.frame(Code = c("D", "E", "F","DD", "DDD", "DDDD", "EE", "EEE", "EEEE", "FF", "FFF"),
                              Count_2021 = c(8, 10, 12,44,64,85,105,125,96,46,136))
    
    # Merge Datasets
    DF_Merged_1 = 
      inner_join(Group_1_2020, Group_1_2021)
    
    DFF_Merged_1 = DF_Merged_1 %>% dplyr::select(Code, Count_2020, Count_2021) %>% 
      gather(key = Type, value = Value, -Code) %>% 
      mutate(Type = ifelse(Type == "Count_2020", "2020", "2021"))
    
    DF_Merged_2 = 
      inner_join(Group_2_2020, Group_2_2021)
    
    DFF_Merged_2 = DF_Merged_2 %>% dplyr::select(Code, Count_2020, Count_2021) %>% 
      gather(key = Type, value = Value, -Code) %>% 
      mutate(Type = ifelse(Type == "Count_2020", "2020", "2021"))
    
    
    # ggplot
    ggplot_1 = DFF_Merged_1 %>% 
      ggplot(aes(x = reorder(Code,Value), y = Value, fill = Type, 
                 text = paste("Count:", Value,
                              "<br>", "Offense Code:", Code,
                              "<br>", "Year:", Type))) +
      geom_col(position = "dodge", show.legend = FALSE) +
      xlab("Offense Code") +
      ylab("Count") +
      ggtitle("Group 1 in Year 2020 and  2021") +
      theme(axis.text=element_text(size=8)) 
    
    ggplot_2 = DFF_Merged_2 %>% 
      ggplot(aes(x = reorder(Code,Value), y = Value, fill = Type, 
                 text = paste("Count:", Value,
                              "<br>", "Offense Code:", Code,
                              "<br>", "Year:", Type))) +
      geom_col(position = "dodge", show.legend = FALSE) +
      xlab("Offense Code") +
      ylab("Count") +
      ggtitle("Group 2 in Year 2020 and  2021") +
      theme(axis.text=element_text(size=8)) 
    
    # Interactive Plots
    fig1 = ggplotly(ggplot_1, tooltip = "text")  
    fig2 = ggplotly(ggplot_2, tooltip = "text")  
    subplot(fig1, fig2)
    
  })
}
# Run the application 
shinyApp(ui = ui, server = server)