时间戳

首页 > 解决方案 > 无法使用 grid.arrange() 和 shinyDashboard 在 R 闪亮界面上的一个对象中显示多个绘图

r - 无法使用 grid.arrange() 和 shinyDashboard 在 R 闪亮界面上的一个对象中显示多个绘图

问题描述

我正在使用 R shiny 构建一个简单的应用程序，并且正在努力将多个图显示为一个对象。我尝试了 grid.arrange()、ggpubr 和 multiplot，但没有成功。这是我的 grid.arrange() 代码。我正在尝试在闪亮的界面上显示 oneplot。我在 R Studio 控制台中显示它没有问题。

## Load libraries
packages<-c('shiny','dplyr','DT','data.table','datasets','shinydashboard',
            'ggplot2','tidyr',"stringr", "withr","treemap",
            "shinyBS", 'shinyjs', 'WDI', "magrittr",'shinycssloaders',
            'timevis','gridExtra','reshape2','grid','plotly')
for (package in packages) {
  if (!require(package, character.only=T, quietly=T)) {
    install.packages(package,repos="http://cran.us.r-project.org")
    library(package, character.only=T)
  }
}

data(PlantGrowth)
data1<-filter(PlantGrowth, group=='ctrl')
data2<-filter(PlantGrowth, group=='trt1')
data3<-filter(PlantGrowth, group=='trt2')

p1<-ggplot(data1) + geom_histogram(aes(x=weight),binwidth = 0.5)
p2<-ggplot(data2) + geom_histogram(aes(x=weight),binwidth = 0.5)
p3<-ggplot(data3) + geom_histogram(aes(x=weight),binwidth = 0.5)
oneplot<-grid.arrange(p1,p2,p3,nrow=2)
oneplot


server = function(input, output,session) {
  output$qaqc_dist_plot2<-renderPlot(oneplot)

}
#header -----
header <- dashboardHeader(title = "Database",
                          # Set height of dashboardHeader
                          tags$li(class = "dropdown",
                                  tags$style(HTML("@import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700');
                                  .main-header {max-height: 400px}
                                  .main-header .title {max-height: 400px}
                                  .main-header .logo { height:auto;
                                                       background-color: #FFF;
                                                       font-family: 'Lobster', 'Times New Roman',serif;
                                                      font-color: 'white';
                                                      font-weight: bold;
                                                      font-size: 24px;
                                                      }")),
                          ),
                          disable = FALSE, titleWidth  = '250')

header$children[[3]]$children[[3]]<-tags$h1(" Database", align='left',
                                            style= "color:#FFF; font-family: 'Lobster', 'Times New Roman',serif;")
header$children[[2]]$children[[1]]<-tags$a(href='www.website.com', 
                                           tags$img(src='logo.png',title="app",alt="toxkin_app", 
                                                    style = "{margin-top:-50px;
                                               padding-bottom:0px;padding-top:0px;
                                               margin-left:-30px;
                                               margin-right:-30px;
                                               }",
                                                    height='200',width='200',
                                                    align="left"
                                           ))

## 2. siderbar ------------------------------
siderbar <- dashboardSidebar( width = 250,
                              sidebarMenu(id = 'sidebar',
                                          style = "position: relative; overflow: visible;",
                                          menuItem( "Dashboard", tabName = 'dashboard', icon = icon('dashboard'),
                                                    badgeColor = "teal" ),
                                          menuItem( "Summary Analysis", tabName = 'summary', icon = icon('file-alt'),
                                                    badgeColor = "teal" ),
                                          menuItem( "Detailed Endpoint Summary", tabName = "endpoints", icon = icon('table')),
                                          menuItem( "Data Analysis", tabName = 'analysis', icon = icon('chart-bar') )
                                          
                              )
)

## 3. body --------------------------------

body <- dashboardBody(tabItems(
  tabItem (tabName = "dashboard",
           tags$h2("Overview"),
           #uiOutput('qaqc_dist_plot')
           ), 
  tabItem (tabName = "summary",
           tags$h2("Summary Statistics")), 
  tabItem (tabName="endpoints",
           tags$h2("Detailed Summary")),
  tabItem (tabName="analysis",
           tags$h2("Visualizing  Data"),
           fluidRow(
             box(width=12, status='info', solidHeader = TRUE, 
                 title= 'QAQC', 
                 plotOutput('qaqc_dist_plot2')
             )
           ))))


## put UI together --------------------
ui <- dashboardPage(title = 'App',skin='blue',
                    header, siderbar, body 
)
shiny::shinyApp(ui=ui, server=server) # APP LAUNCH

谢谢！

标签： rggplot2shinyshinydashboard

解决方案

我不知道为什么 usinggrid.arrange不起作用，但是您可以改用该软件包patchwork。

您想要的布局显示在这里。这是完整的示例：

## Load libraries
packages<-c('shiny', 'shinydashboard',
            'ggplot2', 'dplyr', "patchwork")
for (package in packages) {
  if (!require(package, character.only=T, quietly=T)) {
    install.packages(package,repos="http://cran.us.r-project.org")
    library(package, character.only=T)
  }
}

data(PlantGrowth)
data1<-filter(PlantGrowth, group=='ctrl')
data2<-filter(PlantGrowth, group=='trt1')
data3<-filter(PlantGrowth, group=='trt2')

p1<-ggplot(data1) + geom_histogram(aes(x=weight),binwidth = 0.5)
p2<-ggplot(data2) + geom_histogram(aes(x=weight),binwidth = 0.5)
p3<-ggplot(data3) + geom_histogram(aes(x=weight),binwidth = 0.5)

server = function(input, output,session) {
  output$qaqc_dist_plot2<-renderPlot({
    p1 + p2 + p3 + plot_layout(ncol = 2)
  })
  
}
#header -----
header <- dashboardHeader(title = "Database")

## 2. siderbar ------------------------------
siderbar <- dashboardSidebar(width = 250,
                             sidebarMenu(
                               id = 'sidebar',
                               menuItem("Data Analysis", tabName = 'analysis')
                               
                             ))

## 3. body --------------------------------

body <- dashboardBody(tabItems(
  tabItem (tabName="analysis",
           tags$h2("Visualizing  Data"),
           fluidRow(
             box(width=12, status='info', solidHeader = TRUE, 
                 title= 'QAQC', 
                 plotOutput('qaqc_dist_plot2')
             )
           ))))


## put UI together --------------------
ui <- dashboardPage(title = 'App',skin='blue',
                    header, siderbar, body 
)
shiny::shinyApp(ui=ui, server=server) # APP LAUNCH

推荐阅读