Merge branch 'dev'
This commit is contained in:
+243
-4
@@ -5,6 +5,13 @@ library(reshape2)
|
|||||||
library(Matrix)
|
library(Matrix)
|
||||||
library(CitFuns)
|
library(CitFuns)
|
||||||
library(BDCIT)
|
library(BDCIT)
|
||||||
|
library(openCyto)
|
||||||
|
library(flowCore)
|
||||||
|
library(flowWorkspace)
|
||||||
|
library(CytoML)
|
||||||
|
library(ggcyto)
|
||||||
|
|
||||||
|
filter<-dplyr::filter
|
||||||
|
|
||||||
print(getwd())
|
print(getwd())
|
||||||
source("../sqlFunctions.R", encoding = "UTF-8")
|
source("../sqlFunctions.R", encoding = "UTF-8")
|
||||||
@@ -19,6 +26,8 @@ rna<-data.frame("UMID"="","UM"="")
|
|||||||
sqlInitialize(ruta="../ruta_database.R")
|
sqlInitialize(ruta="../ruta_database.R")
|
||||||
|
|
||||||
|
|
||||||
|
# UI ----
|
||||||
|
|
||||||
ui <- fluidPage(
|
ui <- fluidPage(
|
||||||
|
|
||||||
# Application title
|
# Application title
|
||||||
@@ -27,6 +36,8 @@ ui <- fluidPage(
|
|||||||
#sidebarLayout(
|
#sidebarLayout(
|
||||||
#Navbar
|
#Navbar
|
||||||
navbarPage("BDAccess",
|
navbarPage("BDAccess",
|
||||||
|
|
||||||
|
## Update ----
|
||||||
tabPanel("Update",
|
tabPanel("Update",
|
||||||
sidebarPanel(
|
sidebarPanel(
|
||||||
selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")),
|
selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")),
|
||||||
@@ -52,6 +63,8 @@ ui <- fluidPage(
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
|
||||||
|
## Visor ----
|
||||||
tabPanel("Visor",
|
tabPanel("Visor",
|
||||||
sidebarPanel(
|
sidebarPanel(
|
||||||
radioButtons("nhc", label = h3("Código"),
|
radioButtons("nhc", label = h3("Código"),
|
||||||
@@ -63,9 +76,35 @@ ui <- fluidPage(
|
|||||||
mainPanel(
|
mainPanel(
|
||||||
htmlOutput("report"),
|
htmlOutput("report"),
|
||||||
h3("Nitrogen"),
|
h3("Nitrogen"),
|
||||||
tableOutput("nitrogen")
|
tableOutput("nitrogen"),
|
||||||
|
plotOutput("visorplot", height = "1000px")
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
|
||||||
|
## Citometría ----
|
||||||
|
tabPanel("Citometría",
|
||||||
|
sidebarPanel(
|
||||||
|
selectInput("phenotype", "Tipo de análisis", selected="Pop", choices=c("Pop", "IC")),
|
||||||
|
),
|
||||||
|
mainPanel(
|
||||||
|
tabsetPanel(
|
||||||
|
tabPanel("Entrada",
|
||||||
|
actionButton("goButtonDir","Selecciona directorio fenotipo"),
|
||||||
|
textOutput("session"),
|
||||||
|
hr(),
|
||||||
|
actionButton("fcsconvert", "Convertir a fcs"),
|
||||||
|
hr(),
|
||||||
|
actionButton("pngexport", "Exportar informes"),
|
||||||
|
actionButton("popexport", "Actualizar BBDD")
|
||||||
|
),
|
||||||
|
tabPanel("Visor",
|
||||||
|
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
|
||||||
|
## scRNAseq ----
|
||||||
tabPanel("scRNAseq",
|
tabPanel("scRNAseq",
|
||||||
sidebarPanel(
|
sidebarPanel(
|
||||||
textInput("sqlquery", label = "sqlquery", value = ""),
|
textInput("sqlquery", label = "sqlquery", value = ""),
|
||||||
@@ -87,9 +126,10 @@ ui <- fluidPage(
|
|||||||
)
|
)
|
||||||
|
|
||||||
# Define server logic required to draw a histogram
|
# Define server logic required to draw a histogram
|
||||||
|
# Server ----
|
||||||
server <- function(input, output) {
|
server <- function(input, output) {
|
||||||
|
|
||||||
## Update
|
## Update ----
|
||||||
|
|
||||||
values <- reactiveValues()
|
values <- reactiveValues()
|
||||||
values[["DF"]]<-DF
|
values[["DF"]]<-DF
|
||||||
@@ -618,7 +658,8 @@ server <- function(input, output) {
|
|||||||
}
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
## Visor
|
|
||||||
|
## Visor ----
|
||||||
|
|
||||||
output$report<-renderUI({
|
output$report<-renderUI({
|
||||||
samples<-sqlFetch(dta, "samples")
|
samples<-sqlFetch(dta, "samples")
|
||||||
@@ -786,7 +827,205 @@ server <- function(input, output) {
|
|||||||
|
|
||||||
})
|
})
|
||||||
|
|
||||||
## scRNAseq
|
output$visorplot<-renderPlot({
|
||||||
|
if (input$nhc == 3){
|
||||||
|
pops<-sqlFetch(dta, "POPULATIONS")
|
||||||
|
|
||||||
|
g_pop<-pops %>% dplyr::filter(samples == input$id) %>% gather(pop,value,-samples) %>%
|
||||||
|
mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells",
|
||||||
|
"CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>%
|
||||||
|
ggplot(aes(pop, value))+
|
||||||
|
geom_bar(stat="identity", color="black", fill="grey70")+
|
||||||
|
labs(title = input$id, y="% parent", x="")+
|
||||||
|
theme_bw()+
|
||||||
|
theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5))
|
||||||
|
tl<-sqlFetch(dta, "IC") %>% filter(samples == input$id)
|
||||||
|
|
||||||
|
mtl<-melt(tl, variable.name = "Receptors")
|
||||||
|
mtl$Receptors<-as.character(mtl$Receptors) #Para poder depurar bien el texto, lo pasamos a tipo character
|
||||||
|
mtl$Receptors<-gsub("n","-",mtl$Receptors, fixed = T)
|
||||||
|
mtl$Receptors<-gsub("p","+",mtl$Receptors, fixed = T)
|
||||||
|
mtl$Receptors<-gsub("_"," ",mtl$Receptors)
|
||||||
|
mtl[mtl$value < 1, "Receptors"]<-"Other"
|
||||||
|
mtl$Receptors<-gsub("[A-Z]*-*[0-9T]- *", "", mtl$Receptors)
|
||||||
|
mtl$Receptors<-gsub("+ $", "", mtl$Receptors)
|
||||||
|
mtl$Receptors[mtl$Receptors == ""]<-"All Negative"
|
||||||
|
|
||||||
|
mtl$Receptors<-factor(mtl$Receptors)
|
||||||
|
mtl$Population<-factor(mtl$Population, levels = c("CD8", "CD4"))
|
||||||
|
|
||||||
|
# colorCount<-length(unique(mtl$Receptors))
|
||||||
|
# getPalette = colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"))
|
||||||
|
|
||||||
|
color<-c(c("CTLA4+ LAG3+ PD1+ TIGIT+ TIM3+"="black","All Negative"="white","Other"="grey50", "PD1+"="#C07AFF", "CTLA4+"="#3EB3DE","TIM3+"="#5EF551","LAG3+"="#DEBB3E","TIGIT+"="#FA7055"),
|
||||||
|
c("CTLA4+ PD1+"="#6666FF","PD1+ TIM3+"="#849CA8", "LAG3+ PD1+"="#C47F9F","PD1+ TIGIT+"="#D259AA", "CTLA4+ TIM3+"="#4ED498", "CTLA4+ LAG3+"="#8EB78E", "CTLA4+ TIGIT+"="#9C929A", "LAG3+ TIM3+"="#9ED848", "TIGIT+ TIM3+"="#ACB353", "LAG3+ TIGIT+"="#EC964A"),
|
||||||
|
c("CTLA4+ PD1+ TIGIT+"="#B86B6A","CTLA4+ PD1+ TIGIT+ TIM3+"="#B81515","LAG3+ PD1+ TIGIT+"="#007D8A", "PD1+ TIGIT+ TIM3+"="#D64545", "LAG3+ PD1+ TIGIT+ TIM3+"="#0f5860", "LAG3+ TIGIT+ TIM3+"="#50cad3"))
|
||||||
|
|
||||||
|
g_IC<-ggplot(mtl, aes(samples, value, fill=Receptors))+
|
||||||
|
geom_bar(stat="summary", fun="sum",color="black")+
|
||||||
|
labs(x="Patient", y="% CD8+", fill="")+
|
||||||
|
facet_grid(.~Population)+
|
||||||
|
scale_fill_manual(values = color[levels(mtl$Receptors)[levels(mtl$Receptors) %in% unique(mtl$Receptors)]])+
|
||||||
|
theme_bw()+
|
||||||
|
theme(axis.text.x=element_text(angle=45, hjust=1))
|
||||||
|
ggpubr::ggarrange(g_pop, g_IC, heights = c(0.4, 0.6), ncol = 1)
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
## Citometría ----
|
||||||
|
|
||||||
|
observe({
|
||||||
|
if(input$goButtonDir > 0){
|
||||||
|
cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) %>% paste0("/")
|
||||||
|
|
||||||
|
output$session <- renderText(
|
||||||
|
cito_dir
|
||||||
|
)
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
observeEvent(input$fcsconvert,{
|
||||||
|
route<-cito_dir
|
||||||
|
|
||||||
|
files<-list.files(route, ".LMD")
|
||||||
|
for (lmd in files){
|
||||||
|
fcs<-read.FCS(paste0(route,lmd), dataset = 2)
|
||||||
|
# fcs@parameters$desc<-c("FS-A","SS-A", paste("FL",1:10,"-A", sep = ""), "TIME")
|
||||||
|
# fcs@parameters$desc<-c("FS-H","FS-A","FS-W","SS-H","SS-A","TIME", paste("FL",1:10,"-A", sep = ""))
|
||||||
|
keyword(fcs)['$FIL']<-paste0(gsub(".LMD","",lmd), ".fcs")
|
||||||
|
write.FCS(fcs, paste0(route, gsub(".LMD","",lmd), ".fcs"))
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
observeEvent(input$pngexport,{
|
||||||
|
if (input$phenotype == "Pop"){
|
||||||
|
route<-cito_dir
|
||||||
|
|
||||||
|
ws<-open_flowjo_xml(paste0(route,"Populations.wsp"))
|
||||||
|
gs<-flowjo_to_gatingset(ws, name="All Samples")
|
||||||
|
|
||||||
|
sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "Pop ")[[1]][2]) %>%
|
||||||
|
gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
|
||||||
|
|
||||||
|
for (samp in sampleNames(gs)){
|
||||||
|
print(samp)
|
||||||
|
p<-autoplot(gs[[samp]], bins=64)
|
||||||
|
ggsave(paste0(route, samp,".pop.png"),p,width = 10, height = 10)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (input$phenotype == "IC"){
|
||||||
|
route<-cito_dir
|
||||||
|
|
||||||
|
ws<-open_flowjo_xml(paste0(route,"IC.wsp"))
|
||||||
|
gs<-flowjo_to_gatingset(ws, name="All Samples")
|
||||||
|
|
||||||
|
sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "ICs ")[[1]][2]) %>%
|
||||||
|
gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
|
||||||
|
|
||||||
|
names<-sampleNames(gs) %>% gsub("ab|Ab|AB|iso|Iso|ISO| ","",.) %>% unique()
|
||||||
|
|
||||||
|
nodes<-gs_get_pop_paths(gs)
|
||||||
|
nodes_parent<-nodes[!grepl("CTLA4|LAG3|PD1|TIGIT|TIM3|root$", nodes)]
|
||||||
|
nodes_cd4<-nodes[grepl("CTLA4$|LAG3$|PD1$|TIGIT$|TIM3$", nodes) & grepl("/CD4/",nodes)]
|
||||||
|
nodes_cd8<-nodes[grepl("CTLA4$|LAG3$|PD1$|TIGIT$|TIM3$", nodes) & grepl("/CD8/",nodes)]
|
||||||
|
|
||||||
|
for (id in names){
|
||||||
|
print(id)
|
||||||
|
iso<-sampleNames(gs)[grepl(id, sampleNames(gs)) & grepl("iso",sampleNames(gs))]
|
||||||
|
ab<-sampleNames(gs)[grepl(id, sampleNames(gs)) & grepl("ab",sampleNames(gs))]
|
||||||
|
|
||||||
|
g1<-ggcyto_arrange(autoplot(gs[[ab]], nodes_parent, bins=128), nrow=1)
|
||||||
|
g2<-ggcyto_arrange(autoplot(gs[[iso]], nodes_cd8, bins=64), nrow=1)
|
||||||
|
g3<-ggcyto_arrange(autoplot(gs[[ab]], nodes_cd8, bins=64), nrow=1)
|
||||||
|
g4<-ggcyto_arrange(autoplot(gs[[iso]], nodes_cd4, bins=64), nrow=1)
|
||||||
|
g5<-ggcyto_arrange(autoplot(gs[[ab]], nodes_cd4, bins=64), nrow=1)
|
||||||
|
g_all<-gridExtra::gtable_rbind(g1,g2,g3,g4,g5)
|
||||||
|
ggsave(paste0(route,id,".IC.png"), g_all, width = 10, height = 10)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
observeEvent(input$popexport,{
|
||||||
|
if (input$phenotype == "Pop"){
|
||||||
|
route<-cito_dir
|
||||||
|
|
||||||
|
ws<-open_flowjo_xml(paste0(route,"Populations.wsp"))
|
||||||
|
gs<-flowjo_to_gatingset(ws, name="All Samples")
|
||||||
|
|
||||||
|
sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "Pop ")[[1]][2]) %>%
|
||||||
|
gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
|
||||||
|
|
||||||
|
nodes<-sapply(strsplit(gs_get_pop_paths(gs), "/"), tail, 1)
|
||||||
|
nodes<-nodes[grepl("_",nodes)]
|
||||||
|
pop<-gs_pop_get_stats(gs, nodes=nodes,type="percent") %>% as.data.frame %>% mutate(percent=percent*100)
|
||||||
|
|
||||||
|
pop[,"pop"]<-gsub("_","",pop$pop)
|
||||||
|
pop$pop<-gsub(" ","_",pop$pop)
|
||||||
|
pop$pop<-gsub("+","pos",pop$pop, fixed=T)
|
||||||
|
pop$pop<-gsub("-","neg",pop$pop, fixed=T)
|
||||||
|
pop<-rename(pop, "samples"="sample")
|
||||||
|
pop$percent<-round(pop$percent, digits=2)
|
||||||
|
pop_sp<-pop %>% spread(pop, percent)
|
||||||
|
|
||||||
|
pop_sql<-sqlFetch(dta, "POPULATIONS") %>% slice(0)
|
||||||
|
pop_sp<-pop_sp %>% merge(pop_sql, all=T) %>% select(colnames(pop_sql))
|
||||||
|
|
||||||
|
vartypes<-rep("Number", pop_sp %>% select(-samples) %>% colnames %>% length)
|
||||||
|
names(vartypes)<-pop_sp %>% select(-samples) %>% colnames
|
||||||
|
|
||||||
|
sqlSave(dta, pop_sp, tablename="POPULATIONS", append = T, varTypes = vartypes, rownames = F)
|
||||||
|
print("Tabla POPULATIONS sincronizada.")
|
||||||
|
}
|
||||||
|
if (input$phenotype == "IC"){
|
||||||
|
route<-cito_dir
|
||||||
|
|
||||||
|
ws<-open_flowjo_xml(paste0(route,"IC.wsp"))
|
||||||
|
gs<-flowjo_to_gatingset(ws, name="All Samples")
|
||||||
|
|
||||||
|
sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "ICs ")[[1]][2]) %>%
|
||||||
|
gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
|
||||||
|
|
||||||
|
nodes<-gs_get_pop_paths(gs)
|
||||||
|
# nodes<-gsub("â\u0081»", "-", nodes)
|
||||||
|
# nodes<-gsub("â\u0081º", "+", nodes)
|
||||||
|
nodes<-nodes[grepl("CTLA4", nodes)]
|
||||||
|
nodes<-nodes[!grepl("CD4$|CD8$|CTLA4$|TIM3$|PD1$|LAG3$|TIGIT$|/CTLA4â\u0081»$|/TIM3â\u0081»$|/PD1â\u0081»$|/LAG3â\u0081»$|/TIGITâ\u0081»$", nodes)]
|
||||||
|
|
||||||
|
pop<-gs_pop_get_stats(gs, nodes=nodes,type="percent") %>% as.data.frame %>% mutate(percent=percent*100)
|
||||||
|
pop$percent<-round(pop$percent, digits=2)
|
||||||
|
|
||||||
|
pop$pop<-gsub("â\u0081»", "n", pop$pop)
|
||||||
|
pop$pop<-gsub("â\u0081º", "p", pop$pop)
|
||||||
|
pop$pop<-gsub(" ", "_", pop$pop)
|
||||||
|
|
||||||
|
pop["Type"]<-"ab"
|
||||||
|
pop[grepl("iso|ISO|Iso",pop$sample),"Type"]<-"iso"
|
||||||
|
pop$sample<-gsub("iso|ISO|Iso|ab|AB|Ab| ","",pop$sample)
|
||||||
|
|
||||||
|
pop_sp<-pop %>% spread(Type, percent)
|
||||||
|
pop_sp["Net"]<-pop_sp$ab
|
||||||
|
pop_sp[!grepl("CTLA4n_LAG3n_PD1n_TIGITn_TIM3n",pop_sp$pop),"Net"]<-pop_sp[!grepl("CTLA4n_LAG3n_PD1n_TIGITn_TIM3n",pop_sp$pop),"ab"]-pop_sp[!grepl("CTLA4n_LAG3n_PD1n_TIGITn_TIM3n",pop_sp$pop),"iso"]
|
||||||
|
pop_sp$Net[pop_sp$Net < 0]<-0
|
||||||
|
pop_sp["Population"]<-str_extract(pop_sp$pop, "/CD[4,8]{1}/") %>% gsub("/","",.)
|
||||||
|
pop_sp$pop<-sapply(strsplit(pop_sp$pop, "/"), tail, 1)
|
||||||
|
|
||||||
|
pop_sp<-pop_sp %>% select(-ab,-iso) %>% spread(pop,Net)
|
||||||
|
pop_sp$`CTLA4n_LAG3n_PD1n_TIGITn_TIM3n`<- pop_sp %>% select(-`CTLA4n_LAG3n_PD1n_TIGITn_TIM3n`) %>% group_by(sample,Population) %>%
|
||||||
|
gather(pop, value, -sample,-Population) %>% summarise(n=100-sum(value)) %>% pull(n)
|
||||||
|
pop_sp <- rename(pop_sp, "samples"="sample")
|
||||||
|
|
||||||
|
vartypes<-rep("Number", pop_sp %>% select(-samples, -Population) %>% colnames %>% length)
|
||||||
|
names(vartypes)<-pop_sp %>% select(-samples, -Population) %>% colnames
|
||||||
|
|
||||||
|
sqlSave(dta, pop_sp, tablename="IC", append = T, varTypes = vartypes, rownames = F)
|
||||||
|
print("Tabla IC sincronizada.")
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
## scRNAseq ----
|
||||||
|
|
||||||
output$PATID = renderUI({
|
output$PATID = renderUI({
|
||||||
observeEvent(input$goButton, {})
|
observeEvent(input$goButton, {})
|
||||||
|
|||||||
Reference in New Issue
Block a user