文档建议反馈控制台
首页
学习
活动
专区
圈层
工具
MCP广场
文章/答案/技术大牛
发布
首页
学习
活动
专区
圈层
工具
MCP广场
返回腾讯云官网
社区首页 >问答首页 >一个R闪闪发光的应用程序，它同时显示ggplot情节和巧妙的情节。

问一个R闪闪发光的应用程序，它同时显示ggplot情节和巧妙的情节。
EN

Stack Overflow用户
提问于 2019-05-02 22:25:35
回答 2查看 425关注 0票数 1

我正在尝试建立一个R shiny app，它将允许查看与基因表达数据相关的三种类型的图表。

这些数据包括：

一个具有差异表达式分析输出的data.frame (每一行都是一个基因，列是效果大小及其p值)：

代码语言：javascript
运行
复制
set.seed(1)
model.df <- data.frame(id = paste0("g",1:30),symbol = sample(LETTERS[1:5],30,replace=T),
                       group.effect.size = rnorm(30), group.p.value = runif(30,0,1),
                       sex.effect.size = rnorm(30), sex.p.value = runif(30,0,1),
                       stringsAsFactors = F)

一个具有研究设计的data.frame (每一行都是一个样本，列是与该示例相关联的因素)：

代码语言：javascript
运行
复制
set.seed(1)
design.df <- data.frame(group = c(rep("A",6),rep("B",6)), sex = rep(c(rep("F",3),rep("M",3)),2), replicate = rep(1:6,2)) %>% 
  dplyr::mutate(sample = paste0(group,".",sex,"_",replicate))
design.df$group <- factor(design.df$group, levels = c("A","B"))
design.df$sex <- factor(design.df$sex, levels = c("F","M"))

一个具有丰富度的matrix (每一行都是一个基因，每一列都是一个样本)：

代码语言：javascript
运行
复制
set.seed(1)
abundance.mat <- matrix(rnorm(30*12), nrow=30, ncol=12, dimnames=list(model.df$id,design.df$sample))

一个data.frame，它有一个基因集富集分析的结果(每一行都是一个集合名称，列是design.df中每个因素的富集测试p值)：

代码语言：javascript
运行
复制
set.seed(1)
gsea.df <- data.frame(set.name = paste0("S",1:4), group.p.value = format(round(runif(4,0,1),2),scientific = T), sex.p.value = format(round(runif(4,0,1),2),scientific = T), stringsAsFactors = F)

最后，一个data.frame，它将基因与gsea.df中的每个set.name相关联。

代码语言：javascript
运行
复制
set.seed(1)
gene.sets.df <- do.call(rbind,lapply(1:4,function(s) data.frame(set.name = paste0("S",s), id = sample(model.df$id,10,replace = F),stringsAsFactors = F)))

我希望shiny app能够查看这些类型的情节：

  1. Feature Plot -绘制单个用户选择的基因在y-axis上的表达水平和x-axis上的样本，并将其与显示估计效果的毛毛虫图内嵌物结合起来：

​

  1. Feature User-Defined Sets Plot --与Feature Plot一样--然而，它将显示一组用户选择的基因，而不是显示单个-selected基因，因此它将显示出分布的微调：
  1. Feature Sets GSEA Plot -火山图的组合列表，其中x-axis是因子的效果大小，y-axis是效果的-log10(p值)，如果基因属于所选的基因集，则为红色：

​

以下是在用户选择的情况下生成这些数字的三个功能：

代码语言：javascript
运行
复制
featurePlot <- function(selected.id)
{
  replicate.df <- reshape2::melt(abundance.mat[which(rownames(abundance.mat) == selected.id),,drop=F], varnames=c("id","sample")) %>%
    dplyr::left_join(design.df)
  effects.df <- data.frame(factor.name = c("group","sex"), 
                           effect.size = c(dplyr::filter(model.df,id == selected.id)$group.effect.size,dplyr::filter(model.df,id == selected.id)$sex.effect.size),
                           p.value = c(dplyr::filter(model.df,id == selected.id)$group.p.value,dplyr::filter(model.df,id == selected.id)$sex.p.value),
                           stringsAsFactors = F)
  effects.df$factor.name <- factor(effects.df$factor.name, levels = c("group","sex"))
  main.plot <- ggplot(replicate.df,aes(x=replicate,y=value,color=group,shape=sex))+
    geom_point(size=3)+facet_grid(~group,scales="free_x")+
    labs(x="Replicate",y="TPM")+theme_minimal()
  xlims <- c(-1*max(abs(effects.df$effect.size))-0.1*max(abs(effects.df$effect.size)),max(abs(effects.df$effect.size))+0.1*max(abs(effects.df$effect.size)))
  effects.plot <- ggplot(effects.df,aes(x=effect.size,y=factor.name,color=factor.name))+
    geom_point()+
    geom_vline(xintercept=0,linetype="longdash",colour="black",size=0.25)+theme_minimal()+xlim(xlims)+
    theme(legend.position="none")+ylab("")+xlab("Effect Size")

  null.plot <- ggplot(data.frame())+geom_point()+geom_blank()+theme_minimal()
  combined.plot <- gridExtra::arrangeGrob(main.plot,gridExtra::arrangeGrob(null.plot,effects.plot,ncol=1),nrow=1,ncol=2,widths=c(5,2.5))
  return(combined.plot)
}


featureSetPlot <- function(selected.ids)
{
  replicate.df <- reshape2::melt(abundance.mat[which(rownames(abundance.mat) %in% selected.ids),,drop=F], varnames=c("id","sample")) %>%
    dplyr::left_join(design.df)
  replicate.df$replicate <- as.factor(replicate.df$replicate)
  effects.df <- data.frame(factor.name = c("group","sex"), 
                           effect.size = c(dplyr::filter(model.df,id %in% selected.ids)$group.effect.size,dplyr::filter(model.df,id %in% selected.ids)$sex.effect.size),
                           p.value = c(dplyr::filter(model.df,id %in% selected.ids)$group.p.value,dplyr::filter(model.df,id %in% selected.ids)$sex.p.value),
                           stringsAsFactors = F)
  effects.df$factor.name <- factor(effects.df$factor.name, levels = c("group","sex"))
  main.plot <- ggplot(replicate.df,aes(x=replicate,y=value,color=group,fill=sex))+
    geom_violin(trim=F,draw_quantiles=c(0.25,0.5,0.75),alpha=0.25)+facet_grid(~group,scales="free_x")+
    labs(x="Replicate",y="TPM")+theme_minimal()
  effects.plot <- ggplot(effects.df,aes(y=effect.size,x=factor.name,color=factor.name,fill=factor.name))+
    geom_violin(trim=F,draw_quantiles=c(0.25,0.5,0.75),alpha=0.25)+coord_flip()+
    geom_hline(yintercept=0,linetype="longdash",colour="black",size=0.25)+theme_minimal()+
    theme(legend.position="none")+xlab("")+ylab("Effect Size Distribution")

  null.plot <- ggplot(data.frame())+geom_point()+geom_blank()+theme_minimal()
  combined.plot <- gridExtra::arrangeGrob(main.plot,gridExtra::arrangeGrob(null.plot,effects.plot,ncol=1),nrow=1,ncol=2,widths=c(5,2.5))
  return(combined.plot)
}

gseaPlot <- function(selected.set)
{
  plot.df <- model.df %>%
    dplyr::left_join(gene.sets.df %>% dplyr::filter(set.name == selected.set))
  plot.df$set.name[which(is.na(plot.df$set.name))] <- "non.selected"
  plot.df$set.name <- factor(plot.df$set.name, levels = c("non.selected",selected.set))
  factor.names <- c("group","sex")
  gsea.volcano.plot <- lapply(factor.names,function(f)
    plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5),color=plot.df$set.name,colors=c("lightgray","darkred"),x=plot.df[,paste0(f,".effect.size")],y=-log10(plot.df[,paste0(f,".p.value")]),showlegend=F) %>%
      plotly::layout(annotations=list(showarrow=F,x=0.5,y=0.95,align="center",xref="paper",xanchor="center",yref="paper",yanchor="bottom",font=list(size=12,color="darkred"),text=paste0(f," (",dplyr::filter(gsea.df,set.name == selected.set)[,paste0(f,".p.value")],")")),
                     xaxis=list(title=paste0(f," Effect"),zeroline=F),yaxis=list(title="-log10(p-value)",zeroline=F))
  ) %>% plotly::subplot(nrows=1,shareX=F,shareY=T,titleX=T,titleY=T) %>%
    plotly::layout(title=selected.set)
  return(gsea.volcano.plot)
}

因此：

代码语言：javascript
运行
复制
plot.type.choices <- c('Feature User-Defined Set Plot','Feature Sets GSEA Plot','Feature Plot')

所以前两个使用ggplot2来生成它们组合的两个数字中的每一个，然后使用gridExtra::arrangeGrob实现。最后一个使用plotly。

下面是我一直在尝试的shiny代码部分，但是没有结果：

代码语言：javascript
运行
复制
server <- function(input, output)
{
  out.plot <- reactive({
    if(input$plotType == "Feature Plot"){
      out.plot <- featurePlot(selected.id=dplyr::filter(model.df,symbol == input$symbol)$id[1])
    } else if(input$plotType == "Feature User-Defined Set Plot"){
      out.plot <- featureSetPlot(selected.ids=unique(dplyr::filter(model.df,symbol == input$set.symbols)$id))
    } else if(input$plotType == "Feature Sets GSEA Plot"){
      out.plot <- gseaVolcanoPlot(selected.set=input$set.name)
    }
  })

  output$out.plot <- renderPlot({
    if(input$plotType != "Feature Sets GSEA Plot"){
      grid::grid.draw(out.plot())
    } else{
      out.plot()
    }
  })

  output$save <- downloadHandler(
    filename = function() {
      paste0("./plot.pdf")
    },
    content = function(file) {
      ggsave(out.plot(),filename=file,width=10,height=5)
    }
  )
}

ui <- fluidPage(

  tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }"),

  titlePanel("Results Explorer"),

  sidebarLayout(

    sidebarPanel(

      # select plot type
      selectInput("plotType","Plot Type",choices=plot.type.choices),

      #in case Feature User-Defined Set Plot was chosen select the genes
      conditionalPanel(condition="input.plotType=='Feature User-Defined Set Plot'",
                       selectizeInput(inputId="set.symbols",label="Features Set Symbols",choices=unique(model.df$symbol),selected=model.df$symbol[1],multiple=T)),

      #in case Feature Sets GSEA Plot was chosen select the databses
      conditionalPanel(condition="input.plotType=='Feature Sets GSEA Plot'",
                       selectizeInput(inputId="set.name",label="Set Name",choices=unique(gene.sets.df$set.name),selected=gene.sets.df$set.name[1],multiple=F)),

      #in case Feature Plot was chosen select the gene
      conditionalPanel(condition="input.plotType=='Feature Plot'",
                       selectizeInput(inputId="symbol",label="Feature Symbol",choices=unique(model.df$symbol),selected=unique(model.df$symbol)[1],multiple=F)),

      downloadButton('save', 'Save to File')
    ),

    mainPanel(
      plotOutput("output.plot")
    )
  )
)

shinyApp(ui = ui, server = server)

我怀疑这里的renderPlot可能是问题所在，因为我可能不得不在Feature Sets GSEA Plot选项中使用plotly::renderPlotly，但我不太确定如何将其全部绑定到shiny server部分中。

另一个复杂的问题是，基因符号并不是唯一的WRT基因in (如model.df所示)，这是一个很好的解决方案。因此，如果用户选择了Feature Plot选项，那么最好是添加一个列表，该列表将显示所选符号映射到的基因ID的子集(dplyr::filter(model.df == input$symbol)$id)。

谢谢!

r
ggplot2
shiny
plotly
EN

回答 2

Stack Overflow用户

发布于 2019-05-03 13:13:32

我也猜问题是"renderPlot“。一种解决这个问题的不太优雅的方法是将一个输出分割成两个，但只使用"req()“显示其中的一个。

这段代码将成为：

代码语言：javascript
运行
复制
 output$out.plot <- renderPlot({
     ....
})

这是：

代码语言：javascript
运行
复制
output$out.plot1 <- renderPlot({
     req(input$plotType != "Feature Sets GSEA Plot")
     grid::grid.draw(out.plot())
})
output$out.plot2 <- renderPlotly({
     req(input$plotType == "Feature Sets GSEA Plot")
     out.plot()
})

现在，您可以在UI中添加下面的情节。"req()“确保在语句中的语句不是”真实的“(请参见?req)，在本例中为"TRUE”时，不绘制任何内容。用户不会看到这与像您尝试的那样替换一个输出之间的区别。

票数 1
EN

Stack Overflow用户

发布于 2019-05-07 18:00:50

以下是我自始至终的解决方案：

要装载的包：

代码语言：javascript
运行
复制
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(shiny))

生成示例数据：

代码语言：javascript
运行
复制
set.seed(1)
model.df <- data.frame(id = paste0("g",1:30),symbol = sample(LETTERS[1:5],30,replace=T),
                       group.effect.size = rnorm(30), group.p.value = runif(30,0,1),
                       sex.effect.size = rnorm(30), sex.p.value = runif(30,0,1),
                       stringsAsFactors = F)
set.seed(1)
design.df <- data.frame(group = c(rep("A",6),rep("B",6)), sex = rep(c(rep("F",3),rep("M",3)),2), replicate = rep(1:6,2)) %>% 
  dplyr::mutate(sample = paste0(group,".",sex,"_",replicate))
design.df$group <- factor(design.df$group, levels = c("A","B"))
design.df$sex <- factor(design.df$sex, levels = c("F","M"))
set.seed(1)
abundance.mat <- matrix(rnorm(30*12), nrow=30, ncol=12, dimnames=list(model.df$id,design.df$sample))
set.seed(1)
gsea.df <- data.frame(set.name = paste0("S",1:4), group.p.value = format(round(runif(4,0,1),2),scientific = T), sex.p.value = format(round(runif(4,0,1),2),scientific = T), stringsAsFactors = F)
set.seed(1)
gene.sets.df <- do.call(rbind,lapply(1:4,function(s) data.frame(set.name = paste0("S",s), id = sample(model.df$id,10,replace = F),stringsAsFactors = F)))
plot.type.choices <- c("Feature Plot","User-Defined Feature Set Plot","Feature Sets GSEA Plot")

绘图功能：

代码语言：javascript
运行
复制
featurePlot <- function(selected.id)
{
  replicate.df <- reshape2::melt(abundance.mat[which(rownames(abundance.mat) == selected.id),,drop=F], varnames=c("id","sample")) %>%
    dplyr::left_join(design.df)
  effects.df <- data.frame(factor.name = c("group","sex"), 
                           effect.size = c(dplyr::filter(model.df,id == selected.id)$group.effect.size,dplyr::filter(model.df,id == selected.id)$sex.effect.size),
                           p.value = c(dplyr::filter(model.df,id == selected.id)$group.p.value,dplyr::filter(model.df,id == selected.id)$sex.p.value),
                           stringsAsFactors = F)
  effects.df$factor.name <- factor(effects.df$factor.name, levels = c("group","sex"))
  main.plot <- ggplot(replicate.df,aes(x=replicate,y=value,color=group,shape=sex))+
    geom_point(size=3)+facet_grid(~group,scales="free_x")+
    labs(x="Replicate",y="TPM")+theme_minimal()
  xlims <- c(-1*max(abs(effects.df$effect.size))-0.1*max(abs(effects.df$effect.size)),max(abs(effects.df$effect.size))+0.1*max(abs(effects.df$effect.size)))
  effects.plot <- ggplot(effects.df,aes(x=effect.size,y=factor.name,color=factor.name))+
    geom_point()+
    geom_vline(xintercept=0,linetype="longdash",colour="black",size=0.25)+theme_minimal()+xlim(xlims)+
    theme(legend.position="none")+ylab("")+xlab("Effect Size")

  null.plot <- ggplot(data.frame())+geom_point()+geom_blank()+theme_minimal()
  combined.plot <- gridExtra::arrangeGrob(main.plot,gridExtra::arrangeGrob(null.plot,effects.plot,ncol=1),nrow=1,ncol=2,widths=c(5,2.5))
  return(combined.plot)
}


featureSetPlot <- function(selected.ids)
{
  replicate.df <- reshape2::melt(abundance.mat[which(rownames(abundance.mat) %in% selected.ids),,drop=F], varnames=c("id","sample")) %>%
    dplyr::left_join(design.df)
  replicate.df$replicate <- as.factor(replicate.df$replicate)
  effects.df <- data.frame(factor.name = c("group","sex"), 
                           effect.size = c(dplyr::filter(model.df,id %in% selected.ids)$group.effect.size,dplyr::filter(model.df,id %in% selected.ids)$sex.effect.size),
                           p.value = c(dplyr::filter(model.df,id %in% selected.ids)$group.p.value,dplyr::filter(model.df,id %in% selected.ids)$sex.p.value),
                           stringsAsFactors = F)
  effects.df$factor.name <- factor(effects.df$factor.name, levels = c("group","sex"))
  main.plot <- ggplot(replicate.df,aes(x=replicate,y=value,color=group,fill=sex))+
    geom_violin(trim=F,draw_quantiles=c(0.25,0.5,0.75),alpha=0.25)+facet_grid(~group,scales="free_x")+
    labs(x="Replicate",y="TPM")+theme_minimal()
  effects.plot <- ggplot(effects.df,aes(y=effect.size,x=factor.name,color=factor.name,fill=factor.name))+
    geom_violin(trim=F,draw_quantiles=c(0.25,0.5,0.75),alpha=0.25)+coord_flip()+
    geom_hline(yintercept=0,linetype="longdash",colour="black",size=0.25)+theme_minimal()+
    theme(legend.position="none")+xlab("")+ylab("Effect Size Distribution")

  null.plot <- ggplot(data.frame())+geom_point()+geom_blank()+theme_minimal()
  combined.plot <- gridExtra::arrangeGrob(main.plot,gridExtra::arrangeGrob(null.plot,effects.plot,ncol=1),nrow=1,ncol=2,widths=c(5,2.5))
  return(combined.plot)
}

gseaPlot <- function(selected.set)
{
  plot.df <- model.df %>%
    dplyr::left_join(gene.sets.df %>% dplyr::filter(set.name == selected.set))
  plot.df$set.name[which(is.na(plot.df$set.name))] <- "non.selected"
  plot.df$set.name <- factor(plot.df$set.name, levels = c("non.selected",selected.set))
  factor.names <- c("group","sex")
  gsea.plot <- lapply(factor.names,function(f)
    plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5),color=plot.df$set.name,colors=c("lightgray","darkred"),x=plot.df[,paste0(f,".effect.size")],y=-log10(plot.df[,paste0(f,".p.value")]),showlegend=F) %>%
      plotly::layout(annotations=list(showarrow=F,x=0.5,y=0.95,align="center",xref="paper",xanchor="center",yref="paper",yanchor="bottom",font=list(size=12,color="darkred"),text=paste0(f," (",dplyr::filter(gsea.df,set.name == selected.set)[,paste0(f,".p.value")],")")),
                     xaxis=list(title=paste0(f," Effect"),zeroline=F),yaxis=list(title="-log10(p-value)",zeroline=F))
  ) %>% plotly::subplot(nrows=1,shareX=F,shareY=T,titleX=T,titleY=T) %>%
    plotly::layout(title=selected.set)
  return(gsea.plot)
}

服务器：

代码语言：javascript
运行
复制
server <- function(input, output)
{
  out.plot <- reactive({
    if(input$plotType == "Feature Plot"){
      out.plot <- featurePlot(selected.id=dplyr::filter(model.df,symbol == input$symbol)$id[1])
    } else if(input$plotType == "User-Defined Feature Set Plot"){
      out.plot <- featureSetPlot(selected.ids=unique(dplyr::filter(model.df,symbol == input$set.symbols)$id))
    } else if(input$plotType == "Feature Sets GSEA Plot"){
      out.plot <- gseaPlot(selected.set=input$set.name)
    }
  })

  output$feature.plot <- renderPlot({
    req(input$plotType == "Feature Plot")
    grid::grid.draw(out.plot())
  })

  output$user.defined.feature.set.plot <- renderPlot({
    req(input$plotType == "User-Defined Feature Set Plot")
    grid::grid.draw(out.plot())
  })

  output$feature.set.gsea.plot <- renderPlotly({
    req(input$plotType == "Feature Sets GSEA Plot")
    out.plot()
  })

  output$save <- downloadHandler(
    filename = function() {
      paste0("./plot.pdf")
    },
    content = function(file) {
      if(input$plotType != "Feature Sets GSEA Plot"){
        ggsave(out.plot(),filename=file,width=10,height=5)
      } else{
        plotly::export(out.plot(),file=file)
      }
    }
  )
}

UI：

代码语言：javascript
运行
复制
ui <- fluidPage(

  tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }"),

  titlePanel("Results Explorer"),

  sidebarLayout(

    sidebarPanel(

      # select plot type
      selectInput("plotType","Plot Type",choices=plot.type.choices),

      #in case User-Defined Feature Set Plot was chosen select the genes
      conditionalPanel(condition="input.plotType == 'User-Defined Feature Set Plot'",
                       selectizeInput(inputId="set.symbols",label="Features Set Symbols",choices=unique(model.df$symbol),selected=model.df$symbol[1],multiple=T)),

      #in case Feature Sets GSEA Plot was chosen select the databses
      conditionalPanel(condition="input.plotType == 'Feature Sets GSEA Plot'",
                       selectizeInput(inputId="set.name",label="Set Name",choices=unique(gene.sets.df$set.name),selected=gene.sets.df$set.name[1],multiple=F)),

      #in case Feature Plot was chosen select the gene
      conditionalPanel(condition="input.plotType == 'Feature Plot'",
                       selectizeInput(inputId="symbol",label="Feature Symbol",choices=unique(model.df$symbol),selected=unique(model.df$symbol)[1],multiple=F)),

      downloadButton('save', 'Save to File')
    ),

    mainPanel(
      conditionalPanel(
        condition = "input.plotType == 'User-Defined Feature Set Plot'",
        plotOutput("user.defined.feature.set.plot")
      ),
      conditionalPanel(
        condition =  "input.plotType == 'Feature Sets GSEA Plot'",
        plotly::plotlyOutput("feature.set.gsea.plot")
      ),
      conditionalPanel(
        condition =  "input.plotType == 'Feature Plot'",
        plotOutput("feature.plot")
      )
    )
  )
)

呼叫：

代码语言：javascript
运行
复制
shinyApp(ui = ui, server = server)
票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：

https://stackoverflow.com/questions/55961021

复制
相关文章

相似问题

领券

腾讯云开发者

扫码关注腾讯云开发者

扫码关注腾讯云开发者

领取腾讯云代金券

热门产品

热门推荐

更多推荐

Copyright © 2013 - 2025 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有 

深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 深公网安备号 44030502008569

腾讯云计算（北京）有限责任公司 京ICP证150476号 |  京ICP备11018762号 | 京公网安备号11010802020287

问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档