Question

我正在尝试建立一个R shiny app，以便查看与基因表达数据有关的三种图。

数据包括：

一个data.frame，具有差异表达分析的输出（每行是一个基因，列是效应大小及其p值）：

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（每行是一个样本，列是与样本关联的因素）：

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（每一行是一个基因，每一列都是一个样本）：

set.seed(1)
abundance.mat <- matrix(rnorm(30*12), nrow=30, ncol=12, dimnames=list(model.df$id,design.df$sample))

一个data.frame，其结果为gene set enrichment analysis（每行是一个集合名，列是design.df中每个因子的富集测试p值）：

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，它将基因与set.name中的每个gsea.df相关联：

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能够查看以下类型的图：

Feature Plot-在y-axis上绘制用户选择的单个基因的表达水平，在x-axis上绘制样品的表达水平，并将其与显示预计效果：
Feature User-Defined Sets Plot-与Feature Plot相同，但不是显示单个选择的基因，而是显示一组用户选择的基因，因此，不是点，而是显示分布的小提琴：
Feature Sets GSEA Plot-火山图的组合列表，其中每个x-axis是因子的影响大小，y-axis是-log10（p-value）的效果，并且如果这些基因属于选定的基因集，则将它们染成红色：

以下是根据用户选择生成这些图形的三个功能：

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)
}

因此：

plot.type.choices <- c('Feature User-Defined Set Plot','Feature Sets GSEA Plot','Feature Plot')

因此，前两个使用ggplot2生成它们组合的两个图形中的每个图形，然后使用gridExtra::arrangeGrob实现。最后一个使用plotly。

这是我一直在尝试的shiny代码部分，但是没有运气：

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可能是个问题，因为我可能必须将plotly::renderPlotly用于Feature Sets GSEA Plot选项，但是我不确定如何将所有内容捆绑在一起在shiny server部分中。

存在的另一种并发症是解决该问题的一种好方法，那就是基因符号不是唯一的WRT基因ID（如model.df中所示）。因此，如果用户选择了Feature Plot选项，最好添加一个列表，该列表将显示所选符号映射到的基因ID的子集（dplyr::filter(model.df == input$symbol)$id）

谢谢！

Answer 1

我也猜到问题是“ renderPlot”。解决这个问题的一种方法不是那么优雅，而是将一个输出分成两个，而不是一个输出，但是只能使用“ req（）”显示两个输出。

这段代码将变成：

DATA_SET

此：

 output$out.plot <- renderPlot({
     ....
})

您现在可以在用户界面中以彼此下方的方式添加绘图。 “ req（）”可确保当其中的语句不是“真实的”（请参阅？req）（在本例中为“ TRUE”）时，绝对不会绘制任何内容。用户不会看到这与像您尝试的那样替换一个输出之间的区别。

Answer 2

这是我从头到尾的解决方案：

要加载的包裹：

suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(shiny))

生成示例数据：

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")

绘图功能：

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)
}

服务器：

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：

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")
      )
    )
  )
)

致电：

shinyApp(ui = ui, server = server)

一个R闪亮的应用，可同时显示ggplot图和绘图图

2 个答案: