From 38aa06c4ee32d9a1868d8116a772b44df00f5794 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 11:34:43 +0200 Subject: [PATCH 1/8] =?UTF-8?q?A=C3=B1adir=20etiquetas=20para=20el=20c?= =?UTF-8?q?=C3=B3digo.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/BDAccess/app.R b/BDAccess/app.R index bbbc7e6..93491ab 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -19,6 +19,8 @@ rna<-data.frame("UMID"="","UM"="") sqlInitialize(ruta="../ruta_database.R") +# UI ---------------------------------------------------------------------- + ui <- fluidPage( # Application title @@ -27,6 +29,8 @@ ui <- fluidPage( #sidebarLayout( #Navbar navbarPage("BDAccess", + +# * Update ------------------------------------------------------------------ tabPanel("Update", sidebarPanel( selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")), @@ -52,6 +56,8 @@ ui <- fluidPage( ) ) ), + +# * Visor ------------------------------------------------------------------- tabPanel("Visor", sidebarPanel( radioButtons("nhc", label = h3("Código"), @@ -88,9 +94,9 @@ ui <- fluidPage( # Define server logic required to draw a histogram server <- function(input, output) { - - ## Update - + +# Update ------------------------------------------------------------------ + values <- reactiveValues() values[["DF"]]<-DF values[["samples"]]<-samples @@ -618,8 +624,9 @@ server <- function(input, output) { } }) - ## Visor - + +# Visor ------------------------------------------------------------------- + output$report<-renderUI({ samples<-sqlFetch(dta, "samples") if (input$nhc == 1){samples_sel<-samples %>% filter(OVID == input$id)} From 35e4d31495eda158fabda858e64ee0b99e9cee61 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 11:35:23 +0200 Subject: [PATCH 2/8] =?UTF-8?q?Iniciar=20secci=C3=B3n=20citometr=C3=ADa.?= =?UTF-8?q?=20Bot=C3=B3n=20para=20el=20directorio.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/BDAccess/app.R b/BDAccess/app.R index 93491ab..32ea54d 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -72,6 +72,27 @@ ui <- fluidPage( tableOutput("nitrogen") ) ), + +# * Citometría -------------------------------------------------------------- + tabPanel("Citometría", + sidebarPanel( + # shinyDirButton(id="cito_dir",label="Cito Dir", title="Citometría") + + # fileInput(inputId = "cito_dir", label = "Cito Dir", multiple = F) + ), + mainPanel( + actionButton("goButtonDir","load session to analyze"), + textOutput("session") + # tabsetPanel( + # tabPanel("Table", tableOutput("sc_table")), + # tabPanel("Plots", + # plotOutput("sc_plot", height = "1000px"), + # plotOutput("sc_expr"), height = "600px") + # ) + ) + ), + +# * scRNAseq ---------------------------------------------------------------- tabPanel("scRNAseq", sidebarPanel( textInput("sqlquery", label = "sqlquery", value = ""), @@ -793,8 +814,22 @@ server <- function(input, output) { }) - ## scRNAseq - + +# Citometría -------------------------------------------------------------- + + observe({ + if(input$goButtonDir > 0){ + cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) + + output$session <- renderText( + cito_dir + ) + } + }) + + +# scRNAseq ---------------------------------------------------------------- + output$PATID = renderUI({ observeEvent(input$goButton, {}) sc_cod<-sqlFetch(dta, "CNAG") %>% pull(CODIGO) From db6c07595cabaa253cf680884fa22e58cb214724 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 11:37:56 +0200 Subject: [PATCH 3/8] Cambiar etiquetas. --- BDAccess/app.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/BDAccess/app.R b/BDAccess/app.R index 32ea54d..f24c797 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -19,7 +19,7 @@ rna<-data.frame("UMID"="","UM"="") sqlInitialize(ruta="../ruta_database.R") -# UI ---------------------------------------------------------------------- +# UI ---- ui <- fluidPage( @@ -30,7 +30,7 @@ ui <- fluidPage( #Navbar navbarPage("BDAccess", -# * Update ------------------------------------------------------------------ +## Update ---- tabPanel("Update", sidebarPanel( selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")), @@ -57,7 +57,7 @@ ui <- fluidPage( ) ), -# * Visor ------------------------------------------------------------------- +## Visor ---- tabPanel("Visor", sidebarPanel( radioButtons("nhc", label = h3("Código"), @@ -73,7 +73,7 @@ ui <- fluidPage( ) ), -# * Citometría -------------------------------------------------------------- +## Citometría ---- tabPanel("Citometría", sidebarPanel( # shinyDirButton(id="cito_dir",label="Cito Dir", title="Citometría") @@ -92,7 +92,7 @@ ui <- fluidPage( ) ), -# * scRNAseq ---------------------------------------------------------------- +## scRNAseq ---- tabPanel("scRNAseq", sidebarPanel( textInput("sqlquery", label = "sqlquery", value = ""), @@ -114,9 +114,10 @@ ui <- fluidPage( ) # Define server logic required to draw a histogram +# Server ---- server <- function(input, output) { -# Update ------------------------------------------------------------------ +## Update ---- values <- reactiveValues() values[["DF"]]<-DF @@ -646,7 +647,7 @@ server <- function(input, output) { }) -# Visor ------------------------------------------------------------------- +## Visor ---- output$report<-renderUI({ samples<-sqlFetch(dta, "samples") @@ -815,7 +816,7 @@ server <- function(input, output) { }) -# Citometría -------------------------------------------------------------- +## Citometría ---- observe({ if(input$goButtonDir > 0){ @@ -828,7 +829,7 @@ server <- function(input, output) { }) -# scRNAseq ---------------------------------------------------------------- +## scRNAseq ---- output$PATID = renderUI({ observeEvent(input$goButton, {}) From 67ba4921ca64504f1f754312be6596ea4fc28523 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 15:40:54 +0200 Subject: [PATCH 4/8] =?UTF-8?q?A=C3=B1adir=20secci=C3=B3n=20de=20citometr?= =?UTF-8?q?=C3=ADa=20para=20tinciones=20de=20Poblaciones.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 83 ++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 71 insertions(+), 12 deletions(-) diff --git a/BDAccess/app.R b/BDAccess/app.R index f24c797..ba61117 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -5,6 +5,10 @@ library(reshape2) library(Matrix) library(CitFuns) library(BDCIT) +library(openCyto) +library(flowCore) +library(flowWorkspace) +library(CytoML) print(getwd()) source("../sqlFunctions.R", encoding = "UTF-8") @@ -76,19 +80,16 @@ ui <- fluidPage( ## Citometría ---- tabPanel("Citometría", sidebarPanel( - # shinyDirButton(id="cito_dir",label="Cito Dir", title="Citometría") - - # fileInput(inputId = "cito_dir", label = "Cito Dir", multiple = F) + selectInput("phenotype", "Tipo de análisis", selected="Pop", choices=c("Pop", "IC")), ), mainPanel( - actionButton("goButtonDir","load session to analyze"), - textOutput("session") - # tabsetPanel( - # tabPanel("Table", tableOutput("sc_table")), - # tabPanel("Plots", - # plotOutput("sc_plot", height = "1000px"), - # plotOutput("sc_expr"), height = "600px") - # ) + actionButton("goButtonDir","Selecciona directorio fenotipo"), + textOutput("session"), + hr(), + actionButton("fcsconvert", "Convertir a fcs"), + hr(), + actionButton("pngexport", "Exportar informes"), + actionButton("popexport", "Actualizar BBDD") ) ), @@ -820,7 +821,7 @@ server <- function(input, output) { observe({ if(input$goButtonDir > 0){ - cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) + cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) %>% paste0("/") output$session <- renderText( cito_dir @@ -828,6 +829,64 @@ server <- function(input, output) { } }) + 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,{ + 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,".png"),p,width = 10, height = 10) + } + + }) + + observeEvent(input$popexport,{ + 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) + + 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.") + + }) ## scRNAseq ---- From ab1684651efdf3aa835c369febb2f064163b95f5 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 17:14:42 +0200 Subject: [PATCH 5/8] Completado procesado de datos de Checkpoint Inhibitors. --- BDAccess/app.R | 185 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 137 insertions(+), 48 deletions(-) diff --git a/BDAccess/app.R b/BDAccess/app.R index ba61117..e9a575d 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -9,6 +9,9 @@ library(openCyto) library(flowCore) library(flowWorkspace) library(CytoML) +library(ggcyto) + +filter<-dplyr::filter print(getwd()) source("../sqlFunctions.R", encoding = "UTF-8") @@ -73,7 +76,8 @@ ui <- fluidPage( mainPanel( htmlOutput("report"), h3("Nitrogen"), - tableOutput("nitrogen") + tableOutput("nitrogen"), + plotOutput("visorplot") ) ), @@ -83,13 +87,20 @@ ui <- fluidPage( selectInput("phenotype", "Tipo de análisis", selected="Pop", choices=c("Pop", "IC")), ), mainPanel( - actionButton("goButtonDir","Selecciona directorio fenotipo"), - textOutput("session"), - hr(), - actionButton("fcsconvert", "Convertir a fcs"), - hr(), - actionButton("pngexport", "Exportar informes"), - actionButton("popexport", "Actualizar BBDD") + 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", + + ) + ) ) ), @@ -843,50 +854,128 @@ server <- function(input, output) { }) observeEvent(input$pngexport,{ - 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,".png"),p,width = 10, height = 10) + 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,{ - 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) - - 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.") - - }) + 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) + + 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 ---- From a5581182c2777cbe20672467b7b65cef2b1c4d01 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 17:15:12 +0200 Subject: [PATCH 6/8] =?UTF-8?q?A=C3=B1adir=20al=20visor=20de=20muestras=20?= =?UTF-8?q?el=20plot=20de=20poblaciones.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/BDAccess/app.R b/BDAccess/app.R index e9a575d..a6f38ee 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -827,6 +827,21 @@ server <- function(input, output) { }) + output$visorplot<-renderPlot({ + if (input$nhc == 3){ + pops<-sqlFetch(dta, "POPULATIONS") + + 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)) + } + }) + ## Citometría ---- From 20bf1d2c2003c756db5d7b402dca24dfcec2c87a Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Mon, 4 Apr 2022 17:30:55 +0200 Subject: [PATCH 7/8] =?UTF-8?q?He=20a=C3=B1adido=20al=20visor=20de=20muest?= =?UTF-8?q?ras=20el=20plot=20de=20IC.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 34 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/BDAccess/app.R b/BDAccess/app.R index a6f38ee..130d65e 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -77,7 +77,7 @@ ui <- fluidPage( htmlOutput("report"), h3("Nitrogen"), tableOutput("nitrogen"), - plotOutput("visorplot") + plotOutput("visorplot", height = "1000px") ) ), @@ -831,7 +831,7 @@ server <- function(input, output) { if (input$nhc == 3){ pops<-sqlFetch(dta, "POPULATIONS") - pops %>% dplyr::filter(samples == input$id) %>% gather(pop,value,-samples) %>% + 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))+ @@ -839,6 +839,36 @@ server <- function(input, output) { 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) } }) From cb6c739d14f24636761b35ee4c4da00c2c547f2e Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Tue, 5 Apr 2022 10:08:26 +0200 Subject: [PATCH 8/8] =?UTF-8?q?Para=20actualizar=20la=20tabla=20Poblacione?= =?UTF-8?q?s=20de=20citometr=C3=ADa,=20permitir=20que=20falten=20poblacion?= =?UTF-8?q?es=20(de=20cara=20a=20agrupar=20diferentes=20paneles).?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/BDAccess/app.R b/BDAccess/app.R index 130d65e..b15a8fd 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -969,6 +969,9 @@ server <- function(input, output) { 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