ixxmu
commented
1 year ago Shiny|自测单细胞数据供人访问 by 朴素的科研打工仔
写在前面的话
人工智能领域的卷反而降低了入门新领域的门槛，从ChatGPT了解使用Shiny包构建基于Seruat包的单细胞数据可视化平台---（汇报神器），代码记录~
后续重点会放在空转文献分享和工具学习，看好23年空转井喷式爆发！！
利用ChatGPT初步了解
Server.R
为了减轻rds文件的大小，读取后再进行数据处理。
library(shiny)
library(Seurat)
library(ggpubr)
options(shiny.maxRequestSize=200000*1024^2)
scRNA<- readRDS("data/scRNA.rds")
scRNA1<- readRDS("data/human_pig.rds")
DefaultAssay(scRNA) <- "RNA"
scRNA@assays$RNA@data <- scRNA@assays$RNA@counts
scRNA <- NormalizeData(scRNA, normalization.method = "LogNormalize", scale.factor = 10000)
scRNA <- ScaleData(scRNA, features = rownames(scRNA))
DefaultAssay(scRNA1) <- "RNA"
scRNA1@assays$RNA@data <- scRNA1@assays$RNA@counts
scRNA1 <- NormalizeData(scRNA1, normalization.method = "LogNormalize", scale.factor = 10000)
scRNA1 <- ScaleData(scRNA1, features = rownames(scRNA1))
# Define server logic required to draw a histogram
color_cluster=c("#6AB3F4","#D459A2","#3A8F93","#FACC13",
"#5A7FF8","#3A3AC8",
"#8747E0","#12C2C4","#FF7B78",
"#B27EEC","#CE1222",
"#45CFCF","#EBA8A6","#FF6347","#F14764",
"#159CA1","#A21A6D",
"#EBA8A6","#e9148f",
"#AE6800","#32C35E","#5AC722")
names(color_cluster)=c("NK/NKT cells", "T cells","Proliferation","Cycling NKT cells",
"Neutrophil-myeloid progenitors","Cycling T cells",
"Monocytes", "cDC2","cDC1",
"B cells","Plasma B cells",
"Mesenchymal cells","HSC","Endothelial cells","Kupffer cells",
"Neutrophils","Myelocytes",
"Hepatocytes","Cholangiocytes",
"pDC","Basophils","Erythroid cells")
color_cluster1=c("#6AB3F4","#D459A2",
"#5A7FF8",
"#8747E0","#12C2C4","5AC722",
"#B27EEC",
"#45CFCF","#EBA8A6","#FF6347","#F14764",
"#159CA1","#A21A6D",
"#EBA8A6","#e9148f",
"#32C35E","#5AC722")
names(color_cluster1)=c("NK/NKT cells", "T cells",
"Neutrophil-myeloid progenitors",
"Monocytes", "cDC","Late erythroid",
"B/Plasma cells",
"Mesenchymal cells","HSC","Endothelial cells","Macrophage cells",
"Neutrophils","Myelocytes",
"Hepatocytes","Cholangiocytes",
"Basophils","Early/Mid erythroid")
color_group=c("#98BCDA","#EBA8A6")
names(color_group)=c("NBW","IUGR")
resubset<-function(scRNA,gender,cluster){
Idents(scRNA) <- "gender"
scRNA <- subset(scRNA,idents = gender)
Idents(scRNA) <- "celltype"
scRNA <- subset(scRNA,idents = cluster)
}
plot<-function(scRNA,gene,plot){
if(plot == "Vlnplot"){
VlnPlot(scRNA,features =gene,split.by = "group",pt.size = 0.01)+theme_bw()+
theme(panel.grid = element_blank(), axis.text.x=element_text(hjust = 1,vjust=0.5))}
else if(plot == "FeaturePlot"){
FeaturePlot(scRNA,features =gene,split.by = "group",pt.size = 2)}
else if(plot == "Dotplot"){
DotPlot(scRNA,features =gene,split.by = "group")+theme_bw()+coord_flip()}
}
shinyServer(function(input, output){
# Create the UMAP visualization and render it in the plot
output$umap <- renderPlot({
DimPlot(scRNA, reduction = "umap",label = T,label.box = T,cols = color_cluster,repel = T)+ NoLegend()
})
doplot <- eventReactive(input$action,{
plot(resubset(scRNA,input$gender,input$cluster),input$gene,input$method)})
output$plot1 <- renderPlot({doplot()})
output$cluster<-renderUI({
clusterlist<-unique(scRNA@meta.data$celltype)
selectInput("cluster",'Please select the cell type you are interested in:',list=as.vector(clusterlist))
})
output$gender<-renderUI({
genderlist<-unique(scRNA@meta.data$gender)
selectInput("gender",'Please select the gender you are interested in:',list=as.vector(genderlist))
})
output$method<-renderUI({
selectInput("method",'Please select the method to display',list=c("Vlnplot","FeaturePlot","Dotplot"))
})
output$umap1<- renderPlot({
DimPlot(scRNA1, reduction = "umap",label = T,label.box = T,cols = color_cluster1,repel = T)+ NoLegend()
})
doplot1 <- eventReactive(input$action1,{
plot(subset(scRNA1,idents=input$cluster1),input$gene1,input$method1)})
output$plot2 <- renderPlot({doplot1()})
output$dataset <- DT::renderDataTable({
markers<- read.csv("data/markers.csv",row.names = 1)
DT::datatable(markers,extensions = 'Buttons',
options = list(dom='Bfrtip',
buttons=c('copy', 'csv', 'excel', 'print', 'pdf')),
caption="Table 1. irisdata",filter = "top")})
output$dataset1 <- DT::renderDataTable({
markers1<- read.csv("data/markers1.csv",row.names = 1)
DT::datatable(markers1,extensions = 'Buttons',
options = list(dom='Bfrtip',
buttons=c('copy', 'csv', 'excel', 'print', 'pdf')),
caption="Table 2. irisdata",filter = "top")})
output$plotDown <- downloadHandler(
filename = function(){
paste0(input$gene, '.',input$extPlot)
},
content = function(file){
if(input$extPlot == 'pdf'){
pdf(file)
}else if(input$extPlot == 'png'){
png(file)
}else{
jpeg(file)
}
print(plot(resubset(scRNA,input$gender,input$cluster),input$gene,input$method))
dev.off()
}
)
output$plotDown1 <- downloadHandler(
filename = function(){
paste0(input$gene1, '.',input$extPlot1)
},
content = function(file){
if(input$extPlot == 'pdf'){
pdf(file)
}else if(input$extPlot == 'png'){
png(file)
}else{
jpeg(file)
}
print(plot(subset(scRNA1,idents=input$cluster1),input$gene1,input$method1))
dev.off()
}
)
})
ui.R
library(shiny)
scRNA<- readRDS("data/scRNA.rds")
scRNA1<- readRDS("data/human_pig.rds")
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Add a plot of the UMAP visualization
navbarPage('WangLab',inverse = T,collapsible = T,
tabPanel("Guide",titlePanel("Comprehensive single-cell transcriptional profile of IUGR piglet liver with high homology to human")
,h2("Vignettes"),h3("Intrauterine growth restriction (IUGR) is a problem in both human medicine and animal husbandry, and it has a direct impact on both the health and economy. This urgent event requires us to uncover the molecular mechanisms of the disease in order to create more potent interventional strategies. Herein, we constructed single-cell transcriptome profiles (n=41,969) of IUGRs and NBWs (female n=1, male n=3) one-week after birth. We discussed the difference in male and female IUGR, and established that pigs could sever as a useful model for researching on IUGR in humans.
"),h3("On this site, you may explore the variation in expression of IUGRs and NBWs across various subpopulations on the 'IUGR Piglets' page. Additionally on the 'Human and pigs' page, where the list of genes could be retrieved and downloaded, you could examine the levels of gene expression within different subpopulations of pigs and humans.")
,h2("Statement"),h3("The dataset combines the following two studies."),
h4("1.Popescu DM, Botting RA, Stephenson E, Green K, Webb S, Jardine L, Calderbank EF, Polanski K, Goh I, Efremova M, Acres M, Maunder D, Vegh P, Gitton Y, Park JE, Vento-Tormo R, Miao Z, Dixon D, Rowell R, McDonald D, Fletcher J, Poyner E, Reynolds G, Mather M, Moldovan C, Mamanova L, Greig F, Young MD, Meyer KB, Lisgo S, Bacardit J, Fuller A, Millar B, Innes B, Lindsay S, Stubbington MJT, Kowalczyk MS, Li B, Ashenberg O, Tabaka M, Dionne D, Tickle TL, Slyper M, Rozenblatt-Rosen O, Filby A, Carey P, Villani AC, Roy A, Regev A, Roberts I, Behjati S, Laurenti E, Teichmann SA, Haniffa M. Decoding human fetal liver haematopoiesis. Nature. 2019 Oct;574(7778):365-371. doi: 10.1038/s41586-019-1652-y
. Epub 2019 Oct 9. PMID: 31597962
; PMCID: PMC6861135
.
"),h4("2.Ramachandran P, Dobie R, Wilson-Kanamori JR, Dora EF, Henderson BEP, Luu NT, Portman JR, Matchett KP, Brice M, Marwick JA, Taylor RS, Efremova M, Vento-Tormo R, Carragher NO, Kendall TJ, Fallowfield JA, Harrison EM, Mole DJ, Wigmore SJ, Newsome PN, Weston CJ, Iredale JP, Tacke F, Pollard JW, Ponting CP, Marioni JC, Teichmann SA, Henderson NC. Resolving the fibrotic niche of human liver cirrhosis at single-cell level. Nature. 2019 Nov;575(7783):512-518. doi: 10.1038/s41586-019-1631-3
. Epub 2019 Oct 9. PMID: 31597160
; PMCID: PMC6876711
.")
),
tabPanel("IUGR Piglets",plotOutput("umap",width='60%',height='800px'),
sidebarLayout(
sidebarPanel(
conditionalPanel(condition = "input == ture",
selectInput("gene", "Please select the genes you are interested in:",
c(as.list(rownames(scRNA@assays$RNA@counts)),"nCount_RNA","nFeature_RNA",
"percent_mito","percent_ribo","percent_hb"))),
conditionalPanel(condition = "input.cluster==true",
selectInput("cluster", "Please select the cell type you are interested in:",
as.list(levels(scRNA)))),
conditionalPanel(condition = "input.gender==true",
selectInput("gender", "Please select the gender you are interested in:",
choices = c("female","male"))),
conditionalPanel(condition = "input.method==true",
selectInput("method", "Please select the method to display",
choices = c("Vlnplot","FeaturePlot","Dotplot"))),
actionButton("action", "Plot Expression",icon=icon('angle-double-right')),
radioButtons('extPlot', 'Plot output format',
choices = c("PNG"='png', 'PDF'='pdf','JPEG'='jpeg'), inline = T),
helpText('Please choose the format of table and plot that you need, the download
buttons are placed in respective tabs'),
tags$style('#plotDown {background-color: red; color: white}')
),
mainPanel(
plotOutput("plot1"),downloadButton('plotDown',label="Download Plot"),
DT::dataTableOutput("dataset")))),
tabPanel("Human and pigs",plotOutput("umap1",width='60%',height='800px'),
sidebarLayout(
sidebarPanel(
conditionalPanel(condition = "input == ture",
selectInput("gene1", "Please select the genes you are interested in:",
c(as.list(rownames(scRNA1@assays$RNA@counts)),"nCount_RNA","nFeature_RNA",
"percent_mito","percent_ribo","percent_hb"))),
conditionalPanel(condition = "input.cluster==true",
selectInput("cluster1", "Please select the cell type you are interested in:",
as.list(levels(scRNA1)))),
conditionalPanel(condition = "input.method==true",
selectInput("method1", "Please select the method to display",
choices = c("Vlnplot","FeaturePlot","Dotplot"))),
actionButton("action1", "Plot Expression",icon=icon('angle-double-right')),
radioButtons('extPlot1', 'Plot output format',
choices = c("PNG"='png', 'PDF'='pdf','JPEG'='jpeg'), inline = T),
helpText('Please choose the format of table and plot that you need, the download
buttons are placed in respective tabs'),
tags$style('#plotDown1 {background-color: red; color: white}')
),
mainPanel(
plotOutput("plot2"),downloadButton('plotDown1',label="Download Plot"),
DT::dataTableOutput("dataset1")))))
))
#最后就是运行啦，数据可以放在data文件下，新写函数放在www.文件下
runAPP()
最后效果如图：
https://mp.weixin.qq.com/s/kq5xrjzdAHmYHv8t5m1JuA