r - 如何输出两个网格图（grid.draw）并在shinyapp中下载？
问题描述
我使用了 ggnewscale 包的grid.draw()函数来获取绘图
但似乎下载方式与 ggplot2 类型不一样。
我使用 pdf() 将我的绘图结果保存在 shinyapp 中。
但是当我单击下载按钮时，绘图结果不是图片类型或不是 pdf
它让我感到困惑，我查看了几种方法（here）但它不起作用
我也在这里得到一些建议
这是我的可重现代码和数据：
options(encoding = "UTF-8")
library(stats)
library(openxlsx)
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
library(ggpubr)
library(shinythemes)
library(ggpattern)
library(grid)
library(ggh4x)
library(ggnewscale)
library(psych)
library(DT)
library(shinyBS)
library(shinyjs)
###
data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(data)[-1] <- c(paste0("Gene_", 1:50))
Nameff<-structure(list(Name = c("8_TBI(1 month)", "9_control", "9_VEGF",
"10_control", "10_VEGF", "11_Brain Healty", "12_control_1", "12_control_2",
"12_AOD(Jnk1/2/3 ko)", "13_control", "13_Cpt1_ko(Cdh5 driven)",
"14_control", "14_Tsc2ko(Tbx4 driven)", "15_control", "15_Zmpste24 ko",
"16_control", "16_Adrenomedullin\r\nko(Cdh5 driven)", "17_Lung Healthy",
"18_control(14w)", "18_carboplatin(14w)"), Disease = c("TBI\r\n1month",
"VEGF\r\nsti_DG\r\nregion", "VEGF\r\nsti_DG\r\nregion", "VEGF\r\nsti_CA1\r\nregion",
"VEGF\r\nsti_CA1\r\nregion", "Healthy\r\n(Brain)", "AOD", "AOD",
"AOD", "CPT1\r\nko", "CPT1\r\nko", "Tsc2\r\nko", "Tsc2\r\nko",
"Zmpste\r\n_24 ko", "Zmpste\r\n_24 ko", "AM\r\nko", "AM\r\nko",
"Healthy\r\n(Lung)", "Chemo/Radio\r\n(Tibiae)", "Chemo/Radio\r\n(Tibiae)"
), Organ = c("Brain", "Brain", "Brain", "Brain", "Brain", "Brain",
"Lung", "Lung", "Lung", "Lung", "Lung", "Lung", "Lung", "Lung",
"Lung", "Lung", "Lung", "Lung", "Bone", "Bone"), fill = c("#f15a24",
"#FFFFFF", "#f15a24", "#FFFFFF", "#f15a24", "#FFFFFF", "#FFFFFF",
"#FFFFFF", "#00FF00", "#FFFFFF", "#00FF00", "#FFFFFF", "#00FF00",
"#FFFFFF", "#00FF00", "#FFFFFF", "#00FF00", "#FFFFFF", "#FFFFFF",
"#7570B3"), Condition = c("#CCCCFF", "#d9e021", "#d9e021", "#d9e021",
"#d9e021", "#CCCCFF", "#CCCCFF", "#CCCCFF", "#CCCCFF", "#fbb03b",
"#fbb03b", "#fbb03b", "#fbb03b", "#fbb03b", "#fbb03b", "#fbb03b",
"#fbb03b", "#fbb03b", "#d9e021", "#d9e021"), Organ_fill = c("#f15a24",
"#f15a24", "#f15a24", "#f15a24", "#f15a24", "#f15a24", "#00FF00",
"#00FF00", "#00FF00", "#00FF00", "#00FF00", "#00FF00", "#00FF00",
"#00FF00", "#00FF00", "#00FF00", "#00FF00", "#00FF00", "#7570B3",
"#7570B3"), Alpha = c(1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1,
0, 1, 0, 1, 0, 0, 1)), row.names = 22:41, class = "data.frame")
####################################################################
ui <- fluidPage(
theme = shinytheme("superhero"),
##
useShinyjs(),
##
pageWithSidebar(
tags$h4(
Sys.time()),
sidebarPanel(
tags$h3("1111"),
selectInput(
"selectGeneSymbol",
"444d:",
choices = colnames(data[,-1]),
multiple =F,
width = 400,
selected = NULL
),
actionButton(inputId = "plot1", label = "down1",width=80),
actionButton(inputId = "plot2", label = "down2",width=80),
actionButton(inputId = "all",label = "down1&down2",width=120),
hr(),
tags$h5(tags$strong("down:")),
downloadButton("p1", "down1",width=120),
downloadButton("p2", "down2",width=120)
),
mainPanel(
tabsetPanel(
tabPanel(icon("home"),
uiOutput("all")
))
)
)
)
server <- function(input, output, session) {
##
plot_data1 <- reactive({
subset(data, colnames(data[,-1]) %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data, colnames(data[,-1]) %in% input$selectGeneSymbol)
})
##
global <- reactiveValues(out = NULL,
p1 = NULL,
p2 = NULL)
##
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=600)
})
##
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=600)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=600)
})
###############
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
datamean_sd<-data.frame(
Nameff,
mean=tapply(data[,input$selectGeneSymbol],data$Name,mean),
sd=tapply(data[,input$selectGeneSymbol],data$Name,sd)
)
p<-ggplot(data = datamean_sd, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black",alpha=datamean_sd$Alpha) +
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
theme_classic2() +
theme(legend.position = "bottom",
legend.box = "horizontal",
plot.title = element_text(hjust = 0.5),
plot.margin = unit(c(5, 10, 20, 15), "mm"),
strip.background = element_rect(colour="black", fill="white"),
strip.text.x = element_text(size = 6, angle=0),
axis.text.x=element_text(size=8),
strip.placement = "outside"
) +
rotate_x_text(angle = 90)+
scale_fill_manual(name = "Organ",values = unique(datamean_sd$Organ_fill))
gt <- ggplotGrob(p)
grid::grid.newpage(); grid::grid.draw(gt)
})
p2 <- eventReactive(list(input$plot2,
input$all), {
datamean_sd<-data.frame(
Nameff,
mean=tapply(data[,input$selectGeneSymbol],data$Name,mean),
sd=tapply(data[,input$selectGeneSymbol],data$Name,sd)
)
p<-ggplot(data = datamean_sd, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black",alpha=datamean_sd$Alpha) +
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
theme_classic2() +
theme(legend.position = "bottom",
legend.box = "horizontal",
plot.title = element_text(hjust = 0.5),
plot.margin = unit(c(5, 10, 20, 15), "mm"),
strip.background = element_rect(colour="black", fill="white"),
strip.text.x = element_text(size = 6, angle=0),
axis.text.x=element_text(size=8),
strip.placement = "outside"
) +
rotate_x_text(angle = 90)+
scale_fill_manual(name = "Organ",values = unique(datamean_sd$Organ_fill))
gt <- ggplotGrob(p)
grid::grid.newpage(); grid::grid.draw(gt)
})
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({
## plot_list <- list(p1(),p2())
# grid.arrange(grob(p1(),p2(), ncol=1))
lollipop <- gTree(children = gList(p1(), p2()))
grid.draw(lollipop)
})
#download p1
output$p1 <- downloadHandler(
filename = function() {
paste0(input$selectGeneSymbol,"_123",".pdf")
},
content = function(file) {
pdf(file,width=20,height=10)
datamean_sd<-data.frame(
Nameff,
mean=tapply(data[,input$selectGeneSymbol],data$Name,mean),
sd=tapply(data[,input$selectGeneSymbol],data$Name,sd)
)
p<-ggplot(data = datamean_sd, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black",alpha=datamean_sd$Alpha) +
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
theme_classic2() +
theme(legend.position = "bottom",
legend.box = "horizontal",
plot.title = element_text(hjust = 0.5),
plot.margin = unit(c(5, 10, 20, 15), "mm"),
strip.background = element_rect(colour="black", fill="white"),
strip.text.x = element_text(size = 6, angle=0),
axis.text.x=element_text(size=8),
strip.placement = "outside"
) +
rotate_x_text(angle = 90)+
scale_fill_manual(name = "Organ",values = unique(datamean_sd$Organ_fill))
gt <- ggplotGrob(p)
grid::grid.newpage(); grid::grid.draw(gt)
dev.off()
}
)
#download p2
output$p2 <- downloadHandler(
filename = function() {
paste0(input$selectGeneSymbol,"_123",".pdf")
},
content = function(file) {
ggsave(file,p2(),width=20,height=10)
grid::grid.newpage(); grid::grid.draw(gt)
dev.off()
}
)
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
对我来说最大的问题是我使用 grid.draw() 在我闪亮的 p1() 中创建了一个绘图。而且我不知道如何在 downloadHandler() 函数中下载它。
我尝试使用grid::grid.newpage(); grid::grid.draw(gt)indownloadHandler() 但它不起作用。
我找到了一个愚蠢的解决方案，它再次运行p1()in的代码，downloadHandler()所以我可以下载它，但你知道它很复杂。
像这样：
https://stackoverflow.com/questions/46499719/error-in-using-heatmap-as-the-plot-input-of-ggsave
我知道我的下载代码有问题。但我需要你的帮助来处理它。
我需要正确的方法来下载grid.draw(plot)Shinyapp 中的结果。
我发现在 downloadHandler() 中下载 p1 或 p2 的方法并不完美，但我需要一种更好的方法来处理它。
并且所有 p1 和 p2 都是网格类型。我想将它们一起输出。但是当我使用 grid.arrange(p1(),p2()) 函数时它不起作用。因为它用于 ggplot2 类型。
#########
我的第一个问题：由于网格类型图，如何以更好的方式下载 p1 或 p2。
我的第二个问题：如何像 grid.arrange() 函数一样输出 p1() 和 p2() ？
变化谢谢。
解决方案
Here is my solution .I found a fantastic package that gives me inspiration.
The ggplotify package is created by Guangchuang Yu (School of Basic Medical Sciences, Southern Medical University China)
There is a as.ggplot() function. A amazing function.
More secrets about ggplotify can be found here
In my code, I just add as.ggplot in p1(),or p2() .Just to view my answer code below:
options(encoding = "UTF-8")
library(stats)
library(openxlsx)
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
library(ggpubr)
library(shinythemes)
library(ggpattern)
library(grid)
library(ggh4x)
library(ggnewscale)
library(psych)
library(DT)
library(shinyBS)
library(shinyjs)
###
data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(data)[-1] <- c(paste0("Gene_", 1:50))
Nameff<-structure(list(Name = c("8_TBI(1 month)", "9_control", "9_VEGF",
"10_control", "10_VEGF", "11_Brain Healty", "12_control_1", "12_control_2",
"12_AOD(Jnk1/2/3 ko)", "13_control", "13_Cpt1_ko(Cdh5 driven)",
"14_control", "14_Tsc2ko(Tbx4 driven)", "15_control", "15_Zmpste24 ko",
"16_control", "16_Adrenomedullin\r\nko(Cdh5 driven)", "17_Lung Healthy",
"18_control(14w)", "18_carboplatin(14w)"), Disease = c("TBI\r\n1month",
"VEGF\r\nsti_DG\r\nregion", "VEGF\r\nsti_DG\r\nregion", "VEGF\r\nsti_CA1\r\nregion",
"VEGF\r\nsti_CA1\r\nregion", "Healthy\r\n(Brain)", "AOD", "AOD",
"AOD", "CPT1\r\nko", "CPT1\r\nko", "Tsc2\r\nko", "Tsc2\r\nko",
"Zmpste\r\n_24 ko", "Zmpste\r\n_24 ko", "AM\r\nko", "AM\r\nko",
"Healthy\r\n(Lung)", "Chemo/Radio\r\n(Tibiae)", "Chemo/Radio\r\n(Tibiae)"
), Organ = c("Brain", "Brain", "Brain", "Brain", "Brain", "Brain",
"Lung", "Lung", "Lung", "Lung", "Lung", "Lung", "Lung", "Lung",
"Lung", "Lung", "Lung", "Lung", "Bone", "Bone"), fill = c("#f15a24",
"#FFFFFF", "#f15a24", "#FFFFFF", "#f15a24", "#FFFFFF", "#FFFFFF",
"#FFFFFF", "#00FF00", "#FFFFFF", "#00FF00", "#FFFFFF", "#00FF00",
"#FFFFFF", "#00FF00", "#FFFFFF", "#00FF00", "#FFFFFF", "#FFFFFF",
"#7570B3"), Condition = c("#CCCCFF", "#d9e021", "#d9e021", "#d9e021",
"#d9e021", "#CCCCFF", "#CCCCFF", "#CCCCFF", "#CCCCFF", "#fbb03b",
"#fbb03b", "#fbb03b", "#fbb03b", "#fbb03b", "#fbb03b", "#fbb03b",
"#fbb03b", "#fbb03b", "#d9e021", "#d9e021"), Organ_fill = c("#f15a24",
"#f15a24", "#f15a24", "#f15a24", "#f15a24", "#f15a24", "#00FF00",
"#00FF00", "#00FF00", "#00FF00", "#00FF00", "#00FF00", "#00FF00",
"#00FF00", "#00FF00", "#00FF00", "#00FF00", "#00FF00", "#7570B3",
"#7570B3"), Alpha = c(1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1,
0, 1, 0, 1, 0, 0, 1)), row.names = 22:41, class = "data.frame")
####################################################################
ui <- fluidPage(
theme = shinytheme("superhero"),
##
useShinyjs(),
##
pageWithSidebar(
tags$h4(
Sys.time()),
sidebarPanel(
tags$h3("1111"),
selectInput(
"selectGeneSymbol",
"444d:",
choices = colnames(data[,-1]),
multiple =F,
width = 400,
selected = NULL
),
actionButton(inputId = "plot1", label = "down1",width=80),
actionButton(inputId = "plot2", label = "down2",width=80),
actionButton(inputId = "all",label = "down1&down2",width=120),
hr(),
tags$h5(tags$strong("down:")),
downloadButton("p1", "down1",width=120),
downloadButton("p2", "down2",width=120)
),
mainPanel(
tabsetPanel(
tabPanel(icon("home"),
uiOutput("all")
))
)
)
)
server <- function(input, output, session) {
##
plot_data1 <- reactive({
subset(data, colnames(data[,-1]) %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data, colnames(data[,-1]) %in% input$selectGeneSymbol)
})
##
global <- reactiveValues(out = NULL,
p1 = NULL,
p2 = NULL)
##
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=600)
})
##
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=600)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=600)
})
###############
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
datamean_sd<-data.frame(
Nameff,
mean=tapply(data[,input$selectGeneSymbol],data$Name,mean),
sd=tapply(data[,input$selectGeneSymbol],data$Name,sd)
)
p<-ggplot(data = datamean_sd, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black",alpha=datamean_sd$Alpha) +
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
theme_classic2() +
theme(legend.position = "bottom",
legend.box = "horizontal",
plot.title = element_text(hjust = 0.5),
plot.margin = unit(c(5, 10, 20, 15), "mm"),
strip.background = element_rect(colour="black", fill="white"),
strip.text.x = element_text(size = 6, angle=0),
axis.text.x=element_text(size=8),
strip.placement = "outside"
) +
rotate_x_text(angle = 90)+
scale_fill_manual(name = "Organ",values = unique(datamean_sd$Organ_fill))
gt <- ggplotGrob(p)
grid::grid.newpage(); grid::grid.draw(gt)
aa<-as.ggplot(gt)
aa
})
p2 <- eventReactive(list(input$plot2,
input$all), {
omit here
})
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({
## plot_list <- list(p1(),p2())
grid.arrange(grob(p1(),p2(), ncol=1))
})
#download p1
output$p1 <- downloadHandler(
filename = function() {
paste0(input$selectGeneSymbol,"_123",".pdf")
},
content = function(file) {
pdf(file,p1(),width=20,height=10)
## ggsave(file,p1(),width=16, height=10)
}
)
#download p2
output$p2 <- downloadHandler(
filename = function() {
paste0(input$selectGeneSymbol,"_123",".pdf")
},
content = function(file) {
ggsave(file,p2(),width=20,height=10)
}
)
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
推荐阅读
- python - 如何更改 Plotly 保存图像的步骤？
- java - 如何使用spring boot将IP地址存储在带有数据库的java中
- c - 通过编辑数组元素的最后一位编码数字
- c - 可执行文件内的切换方法调用
- java - 使用 keycloak 作为 Broker 并将 ADFS 作为 IDP 重定向时查询字符串丢失
- base64 - 将字符串转换为 base64
- sonarqube - 声纳扫描仪 - 属性文件夹
- powerapps - 使字段可见取决于其他字段 - Powerapps
- perl - 打印文件的每一行
- javascript - JavaScript请求对象-将键作为变量转换为字符串