Fatal编程技术网
  • r/
  • R 一款既显示ggplot绘图又显示plotly绘图的闪亮应用程序

R 一款既显示ggplot绘图又显示plotly绘图的闪亮应用程序

r shiny

R 一款既显示ggplot绘图又显示plotly绘图的闪亮应用程序,r,ggplot2,shiny,plotly,R,Ggplot2,Shiny,Plotly,我正在尝试设置一个R闪亮的应用程序，可以查看与基因表达数据相关的三种类型的图 这些数据包括： Adata.frame具有差异表达分析的输出（每行为一个基因，列为效应大小及其p值）： A矩阵具有丰度（每行为一个基因，每列为一个样本）： 最后是一个data.frame，它将基因与gsea.df中的每个set.name相关联： set.seed(1) gsea.df <- data.frame(set.name = paste0("S",1:4), group.p.value = format(

我正在尝试设置一个
R
闪亮的
应用程序
，可以查看与基因表达数据相关的三种类型的图

这些数据包括：

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

A
矩阵
具有丰度（每行为一个基因，每列为一个样本）：

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

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)))
因此：

我怀疑这里的
renderPlot
可能是个问题，因为我可能必须为
功能集GSEA Plot
选项使用
plotly:：renderPlotly
，但我不确定如何将其全部绑定到
闪亮的
服务器
部分

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


谢谢
 我也猜问题出在“渲染图”上。
解决这个问题的一种不太优雅的方法是，用“req（）”将输出一分为二，而不是一个输出，但只显示两个输出中的一个

这段代码将变成：


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



output$out.plot以下是我自始至终的解决方案：

要加载的包：


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



非常感谢@Jurr.lan。它仍然没有在服务器上加载数据，因此代码中有一部分或几部分仍然不正确。有什么想法吗？

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



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)



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



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



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