Commit in cytometry.

BDAccess/app.R

@@ -1,6 +1,15 @@
 library(shiny)
 library(rhandsontable)
+library(openCyto)
+library(flowCore)
+library(flowWorkspace)
+library(CytoML)
+library(ggcyto)
+library(reshape2)
+library(Matrix)
+library(CitFuns)
 library(BDCIT)
+library(tidyverse)
 
 print(getwd())
 source("../sqlFunctions.R", encoding = "UTF-8")
@@ -15,6 +24,8 @@ rna<-data.frame("UMID"="","UM"="")
 sqlInitialize(ruta="../ruta_database.R")
 
 
+# UI ----
+
 ui <- fluidPage(
 
     # Application title
@@ -23,6 +34,8 @@ ui <- fluidPage(
     #sidebarLayout(
     #Navbar
     navbarPage("BDAccess",
+
+## Update ----
         tabPanel("Update",
             sidebarPanel(
                 selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")),
@@ -48,6 +61,8 @@ ui <- fluidPage(
                 )
             )
         ),
+
+## Visor ----
         tabPanel("Visor",
             sidebarPanel(
                 radioButtons("nhc", label = h3("Código"),
@@ -59,16 +74,61 @@ ui <- fluidPage(
             mainPanel(
                 htmlOutput("report"),
                 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"),
+                             textInput("cytopath", label="Directorio fenotipo", value=""),
+                             textOutput("session"),
+                             hr(),
+                             actionButton("fcsconvert", "Convertir a fcs"),
+                             hr(),
+                             actionButton("pngexport", "Exportar informes"),
+                             actionButton("popexport", "Actualizar BBDD")
+                        ),
+                        tabPanel("Visor",
+
+                        )
+                     )
+                 )
+        ),
+
+## scRNAseq ----
+        tabPanel("scRNAseq",
+                 sidebarPanel(
+                     textInput("sqlquery", label = "sqlquery", value = ""),
+                     uiOutput("PATID"),
+                     checkboxInput("sct_sel", "Mostrar filtrados"),
+                     checkboxInput("cd45_chk", "Purificación CD45"),
+                     textInput("genes", label="genes", value = "")
+                 ),
+                 mainPanel(
+                     tabsetPanel(
+                         tabPanel("Table", tableOutput("sc_table")),
+                         tabPanel("Plots", 
+                                  plotOutput("sc_plot", height = "1000px"),
+                                  plotOutput("sc_expr"), height = "600px")
+                     )
                  )
         )
     )
 )
 
 # Define server logic required to draw a histogram
+# Server ----
 server <- function(input, output) {
 
-    ## Update
+## Update ----
 
     values <- reactiveValues()
     values[["DF"]]<-DF
@@ -84,24 +144,28 @@ server <- function(input, output) {
         print(CCfile)
         if (input$dbtype == "UM"){
             dta<<-odbcConnectAccess2007(access.file = UMfile, 
-                                        pwd = .rs.askForPassword("Enter password:"))
+                                        pwd = getPass::getPass("Enter password:"))
         }
         if (input$dbtype == "OV"){
             dta<<-odbcConnectAccess2007(access.file = OVfile, 
-                                        pwd = .rs.askForPassword("Enter password:"))
+                                        pwd = getPass::getPass("Enter password:"))
         }
         if (input$dbtype == "CC"){
             dta<<-odbcConnectAccess2007(access.file = CCfile, 
-                                        pwd = .rs.askForPassword("Enter password:"))
+                                        pwd = getPass::getPass("Enter password:"))
         }
         print(dta)
         if (input$backup == T){
             if (! input$dbtype %in% c("UM","OV")){
-                sqlBackUp(bu.dir="CC_BU")
-            }else{
-                sqlBackUp()   
+                sqlBackUp(dbfile = CCfile, bu.dir="CC_BU")
             }
-                
+            if (input$dbtype == "UM"){
+              sqlBackUp(dbfile = UMfile)
+            }
+            if (input$dbtype == "OV"){
+                sqlBackUp(dbfile = OVfile)
+            }
+            print("Back up realizado.")   
         }
     })
     
@@ -183,7 +247,9 @@ server <- function(input, output) {
     
     output$CLINICS <- renderRHandsontable({
         if (!is.null(CLINICS)){
-            rhandsontable(values[["CLINICS"]], stretchH = "all", readOnly = F, useTypes = T)   
+            rhandsontable(values[["CLINICS"]], stretchH = "all", readOnly = F, useTypes = T) %>% 
+                hot_col(values[["CLINICS"]] %>% select(lubridate::is.Date) %>% colnames, 
+                        dateFormat = "DD/MM/YYYY", type = "date")
         }
     })
     
@@ -318,7 +384,7 @@ server <- function(input, output) {
             new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID"), all.x=T) %>% arrange(samples)
             samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
             if (today==TRUE){
-                samples.exp$IQ_date<-format(Sys.Date(), "%d/%m/%y")
+                samples.exp$Date_extraction<-format(Sys.Date(), "%d/%m/%y")
             }
             
             nhc.table<-values[["DF"]]
@@ -595,7 +661,8 @@ server <- function(input, output) {
         }
     })
     
-    ## Visor
+
+## Visor ----
 
     output$report<-renderUI({
         samples<-sqlFetch(dta, "samples")
@@ -691,6 +758,7 @@ server <- function(input, output) {
                 sqlFetch(dta, "NITROGEN"),
                 file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","UM-Nitrogen.xlsx")
             )
+            print("Backup Creado.")
             
             table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
             
@@ -721,6 +789,7 @@ server <- function(input, output) {
             
             sqlDrop(dta, "NITROGEN")
             sqlSave(dta, table.um %>% select(-FECHA) %>% filter(!is.na(CODIGO)), tablename="NITROGEN", rownames=F)
+            print("Tabla Actualizada.")
         }
         if (input$dbtype == "OV"){
             ## Copia de backup
@@ -734,6 +803,7 @@ server <- function(input, output) {
                 sqlFetch(dta, "NITROGEN"),
                 file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","OV-Nitrogen.xlsx")
             )
+            print("Backup Creado.")
             
             ## Lectura del excel
             table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
@@ -759,12 +829,602 @@ server <- function(input, output) {
             
             sqlDrop(dta, "NITROGEN")
             sqlSave(dta, table.ov, tablename="NITROGEN", rownames=F)
+            print("Tabla Actualizada.")
         }
 
     })
     
-    ## scRNAseq
+    output$visorplot<-renderPlot({
+        if (input$nhc == 3){
             
+            data<-sqlFetch(dta, "IC") %>% filter(samples == input$id)
+            data1<-data %>% gather(phen, value, -samples, -Population)
+            
+            data1$phen<-gsub("p","+",data1$phen)
+            data1$phen<-gsub("n","-",data1$phen)
+            data1$phen<-gsub("_"," ",data1$phen)
+            
+            data1$phen<-gsub("n","-",data1$phen, fixed = T)
+            data1$phen<-gsub("p","+",data1$phen, fixed = T)
+            data1$phen<-gsub("_"," ",data1$phen)
+            data1[data1$value < 0.5, "phen"]<-"Other"
+            data1$phen<-gsub("[A-Z]*-*[0-9T]- *", "", data1$phen)
+            data1$phen<-gsub("+ $", "", data1$phen)
+            data1$phen[data1$phen == ""]<-"All Negative"
+            
+            # data1<-data1 %>% filter(value > 0.5)
+            
+            data1["phen1"]<-"PD1"
+            data1[!grepl("PD1+", data1$phen),"phen1"]<-NA
+            
+            data1["phen2"]<-"TIM3"
+            data1[!grepl("TIM3+", data1$phen),"phen2"]<-NA
+            
+            data1["phen3"]<-"CTLA4"
+            data1[!grepl("CTLA4+", data1$phen),"phen3"]<-NA
+            
+            data1["phen4"]<-"TIGIT"
+            data1[!grepl("TIGIT+", data1$phen),"phen4"]<-NA
+            
+            data1["phen5"]<-"LAG3"
+            data1[!grepl("LAG3+", data1$phen),"phen5"]<-NA
+            
+            data1<-data1 %>% arrange(desc(value))
+            data2<-data1 %>% filter(!phen %in% c("All Negative","Other"))
+            data1<-rbind(data2, data1 %>% filter(phen %in% c("All Negative","Other")) %>% arrange(desc(phen)))
+            
+            data_cd8<-data1 %>% filter(Population == "CD8")
+            data_cd4<-data1 %>% filter(Population == "CD4")
+            
+            data_cd8$ymax<-cumsum(data_cd8$value)
+            data_cd8$ymin<-c(0, head(data_cd8$ymax, n=-1))
+            
+            data_cd4$ymax<-cumsum(data_cd4$value)
+            data_cd4$ymin<-c(0, head(data_cd4$ymax, n=-1))
+            
+            data1<-rbind(data_cd8, data_cd4)
+            
+            
+            color<-c(c("CTLA4+ LAG3+ PD1+ TIGIT+ TIM3+"="black","All Negative"="grey90","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"))
+            basic.color<-color[c("PD1+","TIGIT+","TIM3+","CTLA4+","LAG3+")]
+            names(basic.color)<-c("PD1","TIGIT","TIM3","CTLA4","LAG3")
+            # Make the plot
+            g1<-ggplot(data1)+
+                facet_wrap(.~Population)+
+                geom_rect(aes(ymax=ymax, ymin=ymin, xmax=4.5, xmin=0), fill=color[data1$phen])+
+                geom_rect(aes(ymax=ymax, ymin=ymin, xmax=5.4, xmin=5, fill=factor(phen1, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                geom_rect(aes(ymax=ymax, ymin=ymin, xmax=5.9, xmin=5.5, fill=factor(phen4, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                geom_rect(aes(ymax=ymax, ymin=ymin, xmax=6.4, xmin=6, fill=factor(phen2, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                geom_rect(aes(ymax=ymax, ymin=ymin, xmax=6.9, xmin=6.5, fill=factor(phen3, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                geom_rect(aes(ymax=ymax, ymin=ymin, xmax=7.4, xmin=7, fill=factor(phen5, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                scale_fill_manual(values = basic.color, na.value="#FFFFFF00", drop=F, limits=c("PD1","TIGIT","TIM3","CTLA4","LAG3"), name="IC")+
+                coord_polar(theta="y") + # Try to remove that to understand how the chart is built initially
+                xlim(c(0, 8)) +# Try to remove that to see how to make a pie chart
+                theme_classic()+
+                theme(strip.background = element_blank(),
+                      strip.text = element_text(size=12, face="bold"),
+                      axis.line = element_blank(),
+                      axis.ticks = element_blank(),
+                      plot.margin = margin(-200,0,0,0),
+                      axis.text = element_blank())
+            
+            # df.color<-data.frame("phen"=names(color), "color"=color)
+            # df.color<-rbind(
+            #     df.color %>% filter(!phen %in% c("All Negative","Other")) %>% arrange(phen),
+            #     df.color %>% filter(phen %in% c("All Negative","Other")) %>% arrange(desc(phen))
+            # )
+            # 
+            # g2<-ggplot(df.color, aes(phen, 1))+
+            #     geom_tile(fill=df.color$color)+
+            #     scale_x_discrete(limits=df.color$phen)+
+            #     ggtitle("Phenotype Combination")+
+            #     theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5),
+            #           axis.text.y = element_blank(),
+            #           axis.ticks = element_blank(),
+            #           axis.title = element_blank(),
+            #           panel.background = element_blank())+
+            #     coord_equal()
+            
+            # g_IC<-ggpubr::ggarrange(g1,g2,ncol=1)
+            g_IC<-g1
+            
+            pops<-sqlFetch(dta, "POPULATIONS")
+            
+            g_pop<-pops %>% 
+              dplyr::filter(sample == input$id) %>% 
+              gather(pop,value,-sample, -code, -fc_time) %>%
+                # mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells",
+                #                                 "CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>%
+              # mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells",
+                                              # "CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>%
+                mutate(value=as.numeric(gsub(",",".",value))) %>% 
+                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){
+            if (input$cytopath == ""){
+                cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) %>% paste0("/")
+            }else{
+                cito_dir<<-input$cytopath %>% gsub("\\","/",. ,fixed=T) %>% gsub("/$", "", .) %>% 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<-stringi::stri_enc_tonative(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)
+            
+            bool.comb<-apply(
+                expand.grid(c("","!"), c("","!"),c("","!"), c("","!"), c("","!")),
+                1,
+                function(x) paste0(x[1],"CTLA4 & ",x[2],"LAG3 & ",x[3],"PD1 & ",x[4], "TIGIT & ",x[5], "TIM3")
+            )
+            
+            bool.name<-apply(
+                expand.grid(c("+","-"), c("+","-"),c("+","-"), c("+","-"), c("+","-")),
+                1,
+                function(x) paste0("CTLA4",x[1]," LAG3",x[2]," PD1",x[3]," TIGIT",x[4]," TIM3",x[5])
+            )
+            
+            print("Booleanos CD8")
+            for (i in 1:length(bool.comb)){
+                call<-substitute(booleanFilter(v), list(v=as.symbol(bool.comb[i])))
+                boolgate<-eval(call)
+                gs_pop_add(gs, boolgate, parent="CD8", name = bool.name[i])
+            }
+            
+            print("Booleanos CD4")
+            for (i in 1:length(bool.comb)){
+                call<-substitute(booleanFilter(v), list(v=as.symbol(bool.comb[i])))
+                boolgate<-eval(call)
+                gs_pop_add(gs, boolgate, parent="CD4", name = bool.name[i])
+            }
+            
+            recompute(gs)
+            
+            names<-sampleNames(gs) %>% gsub("ab|Ab|AB|iso|Iso|ISO| ","",.) %>% unique()
+            
+            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$", 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("-", "n", pop$pop, fixed=T)
+            pop$pop<-gsub("+", "p", pop$pop, fixed=T)
+            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)
+            if (input$dbtype == "OV"){
+                pop_sp <- rename(pop_sp, "samples"="sample")
+            }
+            if (input$dbtype %in% c("UM", "CC")){
+                pop_sp <- rename(pop_sp, "CODIGO"="sample")
+            }
+            
+            pop_sql<-sqlFetch(dta, "IC") %>% slice(0)
+            pop_sp<-pop_sp %>% merge(pop_sql, all=T) %>% select(colnames(pop_sql))
+            
+            for (id in names){
+                print(id)
+                iso<-sampleNames(gs)[grepl(id, sampleNames(gs)) & grepl("iso|Iso|ISO",sampleNames(gs))]
+                ab<-sampleNames(gs)[grepl(id, sampleNames(gs)) & grepl("ab|Ab|AB",sampleNames(gs))]
+                
+                if (input$dbtype == "OV"){
+                    data<-pop_sp %>% filter(samples == id)
+                    data1<-data %>% gather(phen, value, -samples, -Population)
+                }
+                if (input$dbtype %in% c("UM", "CC")){
+                    data<-pop_sp %>% filter(CODIGO == id)
+                    data1<-data %>% gather(phen, value, -CODIGO, -Population)
+                }
+                
+                data1$phen<-gsub("p","+",data1$phen)
+                data1$phen<-gsub("n","-",data1$phen)
+                data1$phen<-gsub("_"," ",data1$phen)
+                
+                data1$phen<-gsub("n","-",data1$phen, fixed = T)
+                data1$phen<-gsub("p","+",data1$phen, fixed = T)
+                data1$phen<-gsub("_"," ",data1$phen)
+                data1[data1$value < 0.5, "phen"]<-"Other"
+                data1$phen<-gsub("[A-Z]*-*[0-9T]- *", "", data1$phen)
+                data1$phen<-gsub("+ $", "", data1$phen)
+                data1$phen[data1$phen == ""]<-"All Negative"
+                
+                # data1<-data1 %>% filter(value > 0.5)
+                
+                data1["phen1"]<-"PD1"
+                data1[!grepl("PD1+", data1$phen),"phen1"]<-NA
+                
+                data1["phen2"]<-"TIM3"
+                data1[!grepl("TIM3+", data1$phen),"phen2"]<-NA
+                
+                data1["phen3"]<-"CTLA4"
+                data1[!grepl("CTLA4+", data1$phen),"phen3"]<-NA
+                
+                data1["phen4"]<-"TIGIT"
+                data1[!grepl("TIGIT+", data1$phen),"phen4"]<-NA
+                
+                data1["phen5"]<-"LAG3"
+                data1[!grepl("LAG3+", data1$phen),"phen5"]<-NA
+                
+                data1<-data1 %>% arrange(desc(value))
+                data2<-data1 %>% filter(!phen %in% c("All Negative","Other"))
+                data1<-rbind(data2, data1 %>% filter(phen %in% c("All Negative","Other")) %>% arrange(desc(phen)))
+                
+                data_cd8<-data1 %>% filter(Population == "CD8")
+                data_cd4<-data1 %>% filter(Population == "CD4")
+                
+                data_cd8$ymax<-cumsum(data_cd8$value)
+                data_cd8$ymin<-c(0, head(data_cd8$ymax, n=-1))
+                
+                data_cd4$ymax<-cumsum(data_cd4$value)
+                data_cd4$ymin<-c(0, head(data_cd4$ymax, n=-1))
+                
+                data1<-rbind(data_cd8, data_cd4)
+                
+                
+                color<-c(c("CTLA4+ LAG3+ PD1+ TIGIT+ TIM3+"="black","All Negative"="grey90","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"))
+                basic.color<-color[c("PD1+","TIGIT+","TIM3+","CTLA4+","LAG3+")]
+                names(basic.color)<-c("PD1","TIGIT","TIM3","CTLA4","LAG3")
+                # Make the plot
+                g_coex<-ggplot(data1)+
+                    facet_grid(factor(Population, levels=c("CD8","CD4"))~.)+
+                    geom_rect(aes(ymax=ymax, ymin=ymin, xmax=4.5, xmin=0), fill=color[data1$phen])+
+                    geom_rect(aes(ymax=ymax, ymin=ymin, xmax=5.4, xmin=5, fill=factor(phen1, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                    geom_rect(aes(ymax=ymax, ymin=ymin, xmax=5.9, xmin=5.5, fill=factor(phen4, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                    geom_rect(aes(ymax=ymax, ymin=ymin, xmax=6.4, xmin=6, fill=factor(phen2, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                    geom_rect(aes(ymax=ymax, ymin=ymin, xmax=6.9, xmin=6.5, fill=factor(phen3, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                    geom_rect(aes(ymax=ymax, ymin=ymin, xmax=7.4, xmin=7, fill=factor(phen5, levels=c("PD1","TIGIT","TIM3","CTLA4","LAG3"))))+
+                    scale_fill_manual(values = basic.color, na.value="#FFFFFF00", drop=F, limits=c("PD1","TIGIT","TIM3","CTLA4","LAG3"), name="IC")+
+                    coord_polar(theta="y") + # Try to remove that to understand how the chart is built initially
+                    xlim(c(0, 8)) +# Try to remove that to see how to make a pie chart
+                    theme_classic()+
+                    theme(strip.background = element_blank(),
+                          strip.text = element_text(size=12, face="bold"),
+                          axis.line = element_blank(),
+                          axis.ticks = element_blank(),
+                          # plot.margin = margin(-200,0,0,0),
+                          axis.text = element_blank())
+                
+                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)]
+                
+                # 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)
+                g1<-ggcyto_arrange(autoplot(gs[[ab]], nodes_parent), nrow=1)
+                g2<-ggcyto_arrange(autoplot(gs[[iso]], nodes_cd8), nrow=1)
+                g3<-ggcyto_arrange(autoplot(gs[[ab]], nodes_cd8), nrow=1)
+                g4<-ggcyto_arrange(autoplot(gs[[iso]], nodes_cd4), nrow=1)
+                g5<-ggcyto_arrange(autoplot(gs[[ab]], nodes_cd4), nrow=1)
+                g_dots<-gridExtra::gtable_rbind(g1,g2,g3,g4,g5)
+                
+                g_all<-ggpubr::ggarrange(g_dots, g_coex, nrow=1, widths=c(0.65,0.35))
+                ggsave(paste0(route,id,".IC.png"), g_all, width = 14, 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)
+            
+            bool.comb<-apply(
+                expand.grid(c("","!"), c("","!"),c("","!"), c("","!"), c("","!")),
+                1,
+                function(x) paste0(x[1],"CTLA4 & ",x[2],"LAG3 & ",x[3],"PD1 & ",x[4], "TIGIT & ",x[5], "TIM3")
+            )
+            
+            bool.name<-apply(
+                expand.grid(c("+","-"), c("+","-"),c("+","-"), c("+","-"), c("+","-")),
+                1,
+                function(x) paste0("CTLA4",x[1]," LAG3",x[2]," PD1",x[3]," TIGIT",x[4]," TIM3",x[5])
+            )
+            
+            for (i in 1:length(bool.comb)){
+                print("Booleanos CD8")
+                call<-substitute(booleanFilter(v), list(v=as.symbol(bool.comb[i])))
+                boolgate<-eval(call)
+                gs_pop_add(gs, boolgate, parent="CD8", name = bool.name[i])
+            }
+            
+            for (i in 1:length(bool.comb)){
+                print("Booleanos CD4")
+                call<-substitute(booleanFilter(v), list(v=as.symbol(bool.comb[i])))
+                boolgate<-eval(call)
+                gs_pop_add(gs, boolgate, parent="CD4", name = bool.name[i])
+            }
+            
+            recompute(gs)
+            
+            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$", 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("-", "n", pop$pop, fixed=T)
+            pop$pop<-gsub("+", "p", pop$pop, fixed=T)
+            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)
+            if (input$dbtype == "OV"){
+                pop_sp <- rename(pop_sp, "samples"="sample")
+            }
+            if (input$dbtype %in% c("UM", "CC")){
+                pop_sp <- rename(pop_sp, "CODIGO"="sample")
+            }
+            
+            pop_sql<-sqlFetch(dta, "IC") %>% slice(0)
+            pop_sp<-pop_sp %>% merge(pop_sql, all=T) %>% select(colnames(pop_sql))
+            
+            if (input$dbtype == "OV"){
+                vartypes<-rep("Number", pop_sp %>% select(-samples, -Population) %>% colnames %>% length)
+                names(vartypes)<-pop_sp %>% select(-samples, -Population) %>% colnames
+            }
+            if (input$dbtype %in% c("UM", "CC")){
+                vartypes<-rep("Number", pop_sp %>% select(-CODIGO, -Population) %>% colnames %>% length)
+                names(vartypes)<-pop_sp %>% select(-CODIGO, -Population) %>% colnames
+            }
+            
+
+            
+            sqlSave(dta, pop_sp, tablename="IC", append = T, varTypes = vartypes, rownames = F)
+            print("Tabla IC sincronizada.")
+        }
+    }) 
+
+
+## scRNAseq ----
+
+    output$PATID = renderUI({
+        observeEvent(input$goButton, {})
+        sc_cod<-sqlFetch(dta, "CNAG") %>% pull(CODIGO)
+        selectizeInput("sc_cod", "CÓDIGO", sc_cod, multiple = T)
+    })
+    
+    output$sc_table<-renderTable({
+        if (input$sct_sel){
+            if (input$sqlquery != ""){
+                print(input$sqlquery)
+                sqlQuery(dta, input$sqlquery)
+            }else{
+                if (!is.null(input$sc_cod)){
+                    sqlFetch(dta, "CNAG") %>% filter(CODIGO %in% input$sc_cod)
+                }else{
+                    sqlFetch(dta, "CNAG")
+                }
+            }
+        }else{
+            sqlFetch(dta, "CNAG")
+        }
+
+    })
+    
+    output$sc_plot <-renderPlot({
+        meta<<-readRDS(paste0(scRNAseqRoute,"metadata_full_object.rds"))
+        
+        if (input$sqlquery != ""){
+            sc_codigos<-sqlQuery(dta, input$sqlquery) %>% pull(CNAG_NAME)
+        }else{
+            if (!is.null(input$sc_cod)){
+                sc_codigos<-sqlFetch(dta, "CNAG") %>% filter(CODIGO %in% input$sc_cod) %>% pull(CNAG_NAME)
+            }else{
+                sc_codigos<-sqlFetch(dta, "CNAG") %>% pull(CNAG_NAME)
+            }
+        }
+        sc_codigos<-gsub(" _","_", sc_codigos )
+        sc_codigos<-gsub("_ ","_", sc_codigos )
+        sc_codigos<-gsub(" ","_", sc_codigos )
+        
+        meta<-meta %>% mutate(sample2=gsub("_CD45", "", sample)) %>% filter(sample2 %in% sc_codigos)
+        if (isFALSE(input$cd45_chk)){ meta<-meta %>% filter(!grepl("_CD45", sample))}
+        
+        g1<-ggplot(meta, aes(coord_x, coord_y, color=predicted.id))+
+            geom_point(size=0.2)+
+            guides(colour = guide_legend(override.aes = list(size=2)))+
+            theme_bw()+
+            theme(aspect.ratio = 1)
+        
+        meta_perc<-meta %>% group_by(sample, predicted.id) %>% summarise(N=n()) %>% mutate(N=perc(N)) %>% 
+            spread(predicted.id, N) %>% gather("predicted.id","N",-sample) %>% mutate(N=case_when(is.na(N)~0,TRUE~N))
+        g2<-ggheatmap(meta_perc, "sample","predicted.id", "N", color = "grey50")
+        ggpubr::ggarrange(g1,g2, ncol=1, heights = c(0.3, 0.7))
+    })
+
+    output$sc_expr <-renderPlot({
+        if (input$genes != ""){
+            expr<-readRDS(paste0(scRNAseqRoute,"expression_full_object.rds"))
+            genes<-strsplit(input$genes, ",")[[1]]
+
+            if (length(genes) > 1){
+                df.expr<-as.data.frame(as.matrix(expr[genes,]))
+                df.expr["Gene"]<-rownames(df.expr)
+                mdf.expr<-melt(df.expr)
+            }else{
+                df.expr<-as.data.frame(t(as.matrix(expr[genes[1],])))
+                df.expr["Gene"]<-genes[1]
+                mdf.expr<-melt(df.expr)
+            }
+            
+            alldata<-merge(meta, mdf.expr, by.x="barcode", by.y = "variable")
+            
+        }
+        
+        # order <- clustsort(alldata %>% spread(Gene, value) %>% select(predicted.id, all_of(genes)) %>%  
+        #                        group_by(predicted.id) %>% summarise(across(all_of(genes), mean)) %>%  as.data.frame)
+        # 
+        # g1<-ggplot(alldata, aes(predicted.id, value, fill=predicted.id))+
+        #     geom_violin(scale = "width")+
+        #     geom_jitter(width=0.2, size=0.1, alpha=0.3)+
+        #     scale_x_discrete(limits=order$x)+
+        #     guides(fill=F)+
+        #     facet_wrap(.~Gene)+
+        #     theme_bw()+
+        #     theme(axis.text.x = element_text(angle=90, hjust=1, vjust = 0.5))
+        g2<-ggheatmap(alldata, x="predicted.id",y="Gene",value="value", color="grey")+coord_equal()
+        # ggpubr::ggarrange(g1,g2, ncol=1)
+        g2
+    })
 }
 
 # Run the application