问题描述
我有单细胞基因表达数据，这意味着我有一个 data.frame 的数千个细胞，其中每个细胞都映射到一个 cluster（即 cluster 代表细胞类型）并具有实验设计背景（例如，细胞被应用了某个treatment）。在这个特定的例子中，我有两个级别的 cluster（top 和 converged），所以在 data.frame 映射单元格到 cluster 中，每个单元格出现两次，每个集群级别一个。此外，还有一个稀疏的gene x cell matrix，它具有每个细胞中每个基因的表达单位。
为简单起见，在我的示例中，每个 cluster 都由来自 treatment 的所有级别的单元格组成：
数据如下：
library(dplyr)
library(Matrix)
#create the experimental design
factors <- "treatment"
contrasts <- c("treatment1 vs. ctrl","treatment2 vs. ctrl","treatment2 vs. treatment1")
top.clusters = paste0("cluster",1:9)
converged.clusters = paste0("cluster",1:27)
design.df <- rbind(expand.grid(factors,contrasts,top.clusters) %>% dplyr::mutate(cluster.level = "top"),expand.grid(factors,converged.clusters) %>% dplyr::mutate(cluster.level = "converged"))
colnames(design.df)[1:3] <- c("factor","contrast","cluster")
design.df$factor <- as.character(design.df$factor)
design.df$contrast <- as.character(design.df$contrast)
design.df$cluster <- as.character(design.df$cluster)
design.df$cluster.level <- as.character(design.df$cluster.level)
#create the gene x cell expression sparse matrix
gbm <- as(matrix(0,nrow = 15000,ncol = 9000,dimnames = list(paste0("gene",1:15000),paste0("cell",1:9000))),"dgCMatrix")
set.seed(1)
gbm[sample(15000*9000,0.1*15000*9000,replace = F)] <- rnorm(0.1*15000*9000,1.5,0.8)
#create the data.frame mapping cells to clusters
observations.df <- rbind(data.frame(cell = paste0("cell",1:9000),cluster = sample(paste0("cluster",1:9),9000,replace=T),treatment = sample(c("ctrl","treatment1","treatment2"),stringsAsFactors = F) %>% dplyr::mutate(cluster.level = "top"),data.frame(cell = paste0("cell",1:27),stringsAsFactors = F) %>% dplyr::mutate(cluster.level = "converged"))
observations.df$treatment <- factor(observations.df$treatment,levels = c("ctrl","treatment2"))
我构建了一个 shiny 应用程序，它具有两个绘图函数，对应于数据的两个差分表达式 test，我还有一组 renderUI 用于对单元格进行子集cluster（对于选定的 cluster.level）、factor 和 contrast。
差异表达测试（适用于选定的基因，但对本文并不重要）是：
A：将 Gamma glm 与 log link function 拟合到所选基因非零值的细胞表达水平
B：将 logistic glm 与 logit link function 拟合到所选单元格中表达（即表达或不表达）的数量基因。
我的问题更多地与我允许用户对单元格进行子集化的 renderUI 集有关。因为它们之间存在依赖性，所以我在它们中使用 !is.null() 条件作为它们所依赖的 input，但我希望获得有关实现这一目标的更好方法的帮助，希望能更快地工作.此外，我还在绘图函数中使用了这些 !is.null() 条件，以及 actionButton 来防止由于进行不同选择时发生的不需要的处理而导致的滞后，但我'我也希望在改进代码方面得到帮助。
这是我对上述数据的 shiny 代码：
library(shiny)
library(ggplot2)
library(ggpmisc)
server <- function(input,output)
{
output$selected.cluster.level <- renderUI({
radioButtons("selected.cluster.level","Select Cluster Level",choices = c("top","converged"),inline=TRUE)
})
output$selected.clusters <- renderUI({
all.clusters <- unique(dplyr::filter(design.df,cluster.level %in% input$selected.cluster.level)$cluster)
selectInput("selected.clusters","Select Clusters",choices = all.clusters,multiple = T,selected = all.clusters)
})
output$selected.factor <- renderUI({
if(!is.null(input$selected.clusters)){
all.factors <- unique(dplyr::filter(design.df,cluster %in% input$selected.clusters)$factor)
selectInput("selected.factor","Select Factor",choices = all.factors,multiple = F,selected = all.factors[1])
}
})
output$selected.contrast <- renderUI({
if(!is.null(input$selected.clusters) & !is.null(input$selected.factor)){
all.contrasts <- unique(dplyr::filter(design.df,factor == input$selected.factor & cluster %in% input$selected.clusters)$contrast)
selectInput("selected.contrast","Select Contrast",choices = all.contrasts,selected = all.contrasts[1])
}
})
output$selected.gene <- renderUI({
selectInput("selected.gene","Select Gene",choices = rownames(gbm),selected = rownames(gbm)[1])
})
test.A.plot <- reactive({
test.A.plot <- NULL
if(input$goButton > 0){
if(!is.null(input$selected.gene) & !is.null(input$selected.clusters) & !is.null(input$selected.factor) & !is.null(input$selected.contrast)){
selected.gene <- isolate(input$selected.gene)
selected.clusters <- isolate(input$selected.clusters)
selected.factor <- isolate(input$selected.factor)
selected.contrast <- isolate(input$selected.contrast)
factor.levels <- strsplit(selected.contrast,split="\\s+?vs\\.\\s+?")[[1]] %>% rev()
selected.observations.df <- dplyr::filter(observations.df,cluster.level %in% input$selected.cluster.level) %>%
dplyr::filter(cluster %in% selected.clusters) %>%
dplyr::select_(.dots = c("cell","cluster",selected.factor)) %>%
dplyr::filter(!!as.symbol(selected.factor) %in% factor.levels)
colnames(selected.observations.df)[which(colnames(selected.observations.df) == selected.factor)] <- "selected.factor"
selected.observations.df$selected.factor <- factor(selected.observations.df$selected.factor,levels = factor.levels)
selected.gbm.vals <- gbm[which(rownames(gbm) == selected.gene),which(colnames(gbm) %in% selected.observations.df$cell)]
plot.df <- selected.observations.df %>%
dplyr::left_join(data.frame(cell=names(selected.gbm.vals),value=unname(selected.gbm.vals)),by=c("cell"="cell")) %>%
dplyr::filter(value > 0)
plot.df$cluster <- factor(plot.df$cluster)
test.A.plot <- ggplot(plot.df,aes(x=selected.factor,y=value)) +
geom_violin(aes(fill=selected.factor,color=selected.factor),alpha=0.3) +
geom_Boxplot(width=0.1,aes(color=selected.factor),fill=NA) +
geom_smooth(mapping=aes(x=selected.factor,y=value,group=cluster),color="black",method="glm",method.args=list(family=Gamma(link='log')),size=1,se=T) +
stat_poly_eq(mapping=aes(x=selected.factor,group=cluster,label=stat(p.value.label)),formula=y~x,parse=T,npcx="center",npcy="bottom") +
scale_fill_manual(limits=factor.levels,values=scales::hue_pal()(length(factor.levels)),drop=F) +
scale_color_manual(limits=factor.levels,drop=F) +
facet_wrap(as.formula("~ cluster")) + theme_minimal() + ylab(paste0("#",selected.gene," value"))+theme(plot.title=element_text(hjust=0.5),legend.title=element_blank(),axis.ticks.x=element_blank(),axis.text.x=element_blank(),axis.title.x=element_blank())
}
}
return(test.A.plot)
})
test.B.plot <- reactive({
test.B.plot <- NULL
if(input$goButton > 0){
if(!is.null(input$selected.gene) & !is.null(input$selected.clusters) & !is.null(input$selected.factor) & !is.null(input$selected.contrast)){
selected.gene <- isolate(input$selected.gene)
selected.clusters <- isolate(input$selected.clusters)
selected.factor <- isolate(input$selected.factor)
selected.contrast <- isolate(input$selected.contrast)
factor.levels <- strsplit(selected.contrast,which(colnames(gbm) %in% selected.observations.df$cell)]
expected.fractions.df <- selected.observations.df %>%
dplyr::group_by(selected.factor) %>%
dplyr::summarise(f.expressed.cells=n()/nrow(selected.observations.df)) %>%
dplyr::mutate(expected.f.expressed.cells = qlogis(f.expressed.cells)) %>%
dplyr::select(-f.expressed.cells)
plot.df <- selected.observations.df %>%
dplyr::left_join(data.frame(cell=names(selected.gbm.vals),by=c("cell"="cell")) %>%
dplyr::mutate(is.expressed = ifelse(value > 0,1,0)) %>% dplyr::select(-value) %>% dplyr::left_join(expected.fractions.df)
plot.df$cluster <- factor(plot.df$cluster)
plot.summary.df <- plot.df %>%
dplyr::group_by(cluster,selected.factor) %>%
dplyr::tally() %>%
dplyr::rename(total.cells=n) %>%
dplyr::left_join(plot.df %>% dplyr::group_by(cluster,selected.factor) %>% dplyr::mutate(n.expressed.cells=sum(is.expressed)) %>% dplyr::select(-is.expressed) %>% unique()) %>%
dplyr::mutate(f.expressed.cells=n.expressed.cells/total.cells) %>%
dplyr::select(f.expressed.cells,cluster,selected.factor) %>%
unique() %>% dplyr::left_join(expected.fractions.df)
#figure out n.col from facet_wrap
facet.wrapped.plot <- ggplot(data = plot.summary.df,aes(x = selected.factor,y = f.expressed.cells,fill = selected.factor)) +
geom_bar(stat = 'identity') +
scale_x_discrete(name = NULL,labels = levels(plot.summary.df$selected.factor),breaks = sort(unique(plot.summary.df$selected.factor))) +
facet_wrap(as.formula("~ cluster")) + theme_minimal()+theme(legend.position="none",plot.title=element_text(hjust=0.5)) + ylab("Fraction of cells")
n.cols <- wrap_dims(length(facet.wrapped.plot))[2]
plot.list <- lapply(levels(plot.df$cluster),function(l){
p.df <- dplyr::filter(plot.summary.df,cluster == l)
n.df <- dplyr::filter(plot.df,cluster == l)
fit <- glm(is.expressed ~ selected.factor + offset(expected.f.expressed.cells),data = n.df,family = binomial(link = 'logit'))
fit.text <- paste0(format(round(summary(fit)$coefficients[2,1],3),scientiffic=T)," (P = ",format(round(summary(fit)$coefficients[2,4],")")
cluster.plot <- ggplot(data = p.df,fill = selected.factor)) +
geom_bar(stat = 'identity') +
stat_function(fun = logitTrendLine,args=list(ests=coef(fit)),size=2,color="black") +
annotate("text",size=4,vjust=0,hjust=0.5,x=1.5,y=0,label=fit.text,color="black") +
scale_x_discrete(name = NULL,labels = factor.levels,breaks = factor.levels) + ylim(0,1) +
theme_minimal()+theme(legend.position="none",plot.title=element_text(hjust=0.5)) + ylab("Fraction of cells") + ggtitle(l)
})
plot.list <- plot.list[which(sapply(plot.list,function(i) !is.null(i)))]
if(length(plot.list) > 0) test.B.plot <- ggpubr::as_ggplot(gridExtra::grid.arrange(grobs=plot.list,ncol=n.cols,top=grid::textGrob(selected.gene)))
}
}
return(test.B.plot)
})
output$out.plot <- renderPlot({
if(input$outputType == "A"){
test.A.plot()
} else if(input$outputType == "B"){
test.B.plot()
}
})
}
ui <- fluidPage(
titlePanel("Data Explorer"),sidebarLayout(
sidebarPanel(
tags$head(
tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome,Safari,Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),tags$style(type="text/css","#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),selectInput("outputType","Output Type",choices = c("A","B")),uIoUtput("selected.cluster.level"),uIoUtput("selected.clusters"),uIoUtput("selected.factor"),uIoUtput("selected.contrast"),uIoUtput("selected.gene"),actionButton(icon=icon("chart-line"),"goButton","Render figure"),),mainPanel(
plotOutput("out.plot")
)
)
)
shinyApp(ui = ui,server = server)
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）