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

Posted

技术标签:

【中文标题】在 R Shiny 中调整 Plotly::subplot 的高度和宽度【英文标题】:Adjusting height and width of Plotly::subplot in R Shiny 【发布时间】:2021-10-18 03:52:34 【问题描述】:

我正在尝试在Rshiny 应用程序中插入plotly::subplotapp 按预期工作,除了 subplot 不会更新绘图大小,即使在 renderPlotly 中使用 heightwidth 参数后也是如此。

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

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

代码

    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)

原始数据快照以显示问题

【问题讨论】:

【参考方案1】:

heightwidth 参数属于 plotlyOutput,您将其传递给 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)

【讨论】:

干杯Shah g,你能不能也看看this的问题?

以上是关于在 R Shiny 中调整 Plotly::subplot 的高度和宽度的主要内容,如果未能解决你的问题,请参考以下文章

R Shiny动态盒子高度

R/Shiny 图不显示在浏览器中

Ggiraph 图表在 Shiny 上调整太多

r Shiny #r #shiny中突出显示的文本输入

r:在 Flexdashboard 中使用 Shiny 渲染 Kable

在 R/Shiny 中获取本地文件数据