Añadir sección de citometría para tinciones de Poblaciones.

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")
+                     selectInput("phenotype", "Tipo de análisis", selected="Pop", choices=c("Pop", "IC")),
-                     
-                     # fileInput(inputId = "cito_dir", label = "Cito Dir", multiple = F)
                  ),
                  mainPanel(
-                     actionButton("goButtonDir","load session to analyze"),
+                     actionButton("goButtonDir","Selecciona directorio fenotipo"),
-                     textOutput("session")
+                     textOutput("session"),
-                     # tabsetPanel(
+                     hr(),
-                     #     tabPanel("Table", tableOutput("sc_table")),
+                     actionButton("fcsconvert", "Convertir a fcs"),
-                     #     tabPanel("Plots", 
+                     hr(),
-                     #              plotOutput("sc_plot", height = "1000px"),
+                     actionButton("pngexport", "Exportar informes"),
-                     #              plotOutput("sc_expr"), height = "600px")
+                     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 ----