Para actualizar la tabla Poblaciones de citometría, permitir que falten poblaciones (de cara a agrupar diferentes paneles).

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", height = "1000px")
             )
         ),
 
@@ -83,13 +87,20 @@ ui <- fluidPage(
                      selectInput("phenotype", "Tipo de análisis", selected="Pop", choices=c("Pop", "IC")),
                  ),
                  mainPanel(
-                     actionButton("goButtonDir","Selecciona directorio fenotipo"),
+                     tabsetPanel(
-                     textOutput("session"),
+                         tabPanel("Entrada",
-                     hr(),
+                             actionButton("goButtonDir","Selecciona directorio fenotipo"),
-                     actionButton("fcsconvert", "Convertir a fcs"),
+                             textOutput("session"),
-                     hr(),
+                             hr(),
-                     actionButton("pngexport", "Exportar informes"),
+                             actionButton("fcsconvert", "Convertir a fcs"),
-                     actionButton("popexport", "Actualizar BBDD")
+                             hr(),
+                             actionButton("pngexport", "Exportar informes"),
+                             actionButton("popexport", "Actualizar BBDD")
+                        ),
+                        tabPanel("Visor",
+
+                        )
+                     )
                  )
         ),
 
@@ -816,6 +827,51 @@ server <- function(input, output) {
 
     })
     
+    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 ----
 
@@ -843,51 +899,132 @@ server <- function(input, output) {
     })
     
     observeEvent(input$pngexport,{
-        route<-cito_dir
+        if (input$phenotype == "Pop"){
+            route<-cito_dir
             
-        ws<-open_flowjo_xml(paste0(route,"Populations.wsp"))
+            ws<-open_flowjo_xml(paste0(route,"Populations.wsp"))
-        gs<-flowjo_to_gatingset(ws, name="All Samples")
+            gs<-flowjo_to_gatingset(ws, name="All Samples")
             
-        sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "Pop ")[[1]][2]) %>% 
+            sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "Pop ")[[1]][2]) %>% 
-            gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
+                gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
             
-        for (samp in sampleNames(gs)){
+            for (samp in sampleNames(gs)){
-            print(samp)
+                print(samp)
-            p<-autoplot(gs[[samp]], bins=64)
+                p<-autoplot(gs[[samp]], bins=64)
-            ggsave(paste0(route, samp,".png"),p,width = 10, height = 10)
+                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
+        if (input$phenotype == "Pop"){
+            route<-cito_dir
             
-        ws<-open_flowjo_xml(paste0(route,"Populations.wsp"))
+            ws<-open_flowjo_xml(paste0(route,"Populations.wsp"))
-        gs<-flowjo_to_gatingset(ws, name="All Samples")
+            gs<-flowjo_to_gatingset(ws, name="All Samples")
             
-        sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "Pop ")[[1]][2]) %>% 
+            sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "Pop ")[[1]][2]) %>% 
-            gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
+                gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T)
             
-        nodes<-sapply(strsplit(gs_get_pop_paths(gs), "/"), tail, 1)
+            nodes<-sapply(strsplit(gs_get_pop_paths(gs), "/"), tail, 1)
-        nodes<-nodes[grepl("_",nodes)]
+            nodes<-nodes[grepl("_",nodes)]
-        pop<-gs_pop_get_stats(gs, nodes=nodes,type="percent") %>% as.data.frame %>% mutate(percent=percent*100)
+            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(" ","_",pop$pop)
+            pop$pop<-gsub(" ","_",pop$pop)
-        pop$pop<-gsub("+","pos",pop$pop, fixed=T)
+            pop$pop<-gsub("+","pos",pop$pop, fixed=T)
-        pop$pop<-gsub("-","neg",pop$pop, fixed=T)
+            pop$pop<-gsub("-","neg",pop$pop, fixed=T)
-        pop<-rename(pop, "samples"="sample")
+            pop<-rename(pop, "samples"="sample")
-        pop$percent<-round(pop$percent, digits=2)
+            pop$percent<-round(pop$percent, digits=2)
-        pop_sp<-pop %>% spread(pop, percent)
+            pop_sp<-pop %>% spread(pop, percent)
             
-        vartypes<-rep("Number", pop_sp %>% select(-samples) %>% colnames %>% length)
+            pop_sql<-sqlFetch(dta, "POPULATIONS") %>% slice(0)
-        names(vartypes)<-pop_sp %>% select(-samples) %>% colnames
+            pop_sp<-pop_sp %>% merge(pop_sql, all=T) %>% select(colnames(pop_sql))
             
-        sqlSave(dta, pop_sp, tablename="POPULATIONS", append = T, varTypes = vartypes, rownames = F)
+            vartypes<-rep("Number", pop_sp %>% select(-samples) %>% colnames %>% length)
-        print("Tabla POPULATIONS sincronizada.")
+            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({