marcelcosta/BDAccess
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

Compare commits

base: marcelcosta/BDAccess:cb6c739d14f24636761b35ee4c4da00c2c547f2e
Branches Tags
marcelcosta/BDAccess:main marcelcosta/BDAccess:dev
..
compare: marcelcosta/BDAccess:main
Branches Tags
marcelcosta/BDAccess:main marcelcosta/BDAccess:dev

22 Commits
cb6c739d14 .. main

Author SHA1 Message Date
marcelcosta d3dcbc3d51 Limpieza de código. 2023-11-22 15:56:39 +01:00
marcelcosta faffd13524 Corrección bug al incorporar nuevo PATID en CC. 2023-11-22 15:50:29 +01:00
Costa 9f7430a4ae Merge branch 'dev' 2023-10-10 12:59:41 +02:00
marcelcosta 4c27e84cbd NHC as a character. 2023-10-10 12:51:15 +02:00
marcelcosta 560540cf1a Commit in cytometry. 2023-10-10 12:35:43 +02:00
marcelcosta bd52e8c452 Corrección nombre de fecha de extracción. Solución de bug. 2023-02-02 16:54:09 +01:00
marcelcosta 43b807cc63 Corrección de la función de backup. 2022-07-04 11:09:20 +02:00
marcelcosta cb38ea347d Añadir notificación de sincronización y backup de nitrógeno. 2022-07-04 11:08:45 +02:00
marcelcosta 6671939939 Cambiar sistema de pedir contraseña. 2022-07-04 10:58:27 +02:00
marcelcosta a6f0c97d47 Añadir la opción de pasar la ruta de citometría en texto. 2022-04-20 15:34:54 +02:00
marcelcosta 56484a5903 Volver a meter unas línias borradas por error. 2022-04-20 12:13:27 +02:00
marcelcosta b5323436ec Boleanas en la app. 2022-04-20 09:49:37 +02:00
marcelcosta a57fb3aac8 Gates booleanas se hacen en R y no en Flowjo (que enlentece mucho el análisis). 2022-04-06 16:54:51 +02:00
marcelcosta dbb8e1ed0d Merge branch 'dev' 2022-04-06 12:42:53 +02:00
marcelcosta e6c2a32ddb Corregir exportar png IC 2022-04-06 12:42:31 +02:00
marcelcosta 51acdd0ece Merge branch 'dev' 2022-04-06 12:35:16 +02:00
marcelcosta dcbf4f8b9d Canvi en l'ordre de les dependències. 2022-04-06 12:32:41 +02:00
marcelcosta 001f64cc76 Merge branch 'dev' 2022-04-06 11:18:24 +02:00
marcelcosta e95caafe28 Cambio a pie chart para Visor IC. 2022-04-05 16:57:26 +02:00
marcelcosta f45ebfd106 Merge branch 'dev' 2022-04-05 10:09:30 +02:00
marcelcosta 38e902cef0 Merge branch 'dev' 2022-04-04 10:53:51 +02:00
marcelcosta 3492b7f7ef Corregir año en la fecha de tabla clinics 2022-04-01 12:26:42 +02:00
2 changed files with 434 additions and 133 deletions
Expand all files Collapse all files
BDAccess/app.R
+421 -122
View File
@@ -1,17 +1,15 @@
library(shiny) library(shiny)
library(rhandsontable) library(rhandsontable)
library(tidyverse)
library(reshape2)
library(Matrix)
library(CitFuns)
library(BDCIT)
library(openCyto) library(openCyto)
library(flowCore) library(flowCore)
library(flowWorkspace) library(flowWorkspace)
library(CytoML) library(CytoML)
library(ggcyto) library(ggcyto)
library(reshape2)
filter<-dplyr::filter library(Matrix)
library(CitFuns)
library(BDCIT)
library(tidyverse)
print(getwd()) print(getwd())
source("../sqlFunctions.R", encoding = "UTF-8") source("../sqlFunctions.R", encoding = "UTF-8")
@@ -90,6 +88,7 @@ ui <- fluidPage(
tabsetPanel( tabsetPanel(
tabPanel("Entrada", tabPanel("Entrada",
actionButton("goButtonDir","Selecciona directorio fenotipo"), actionButton("goButtonDir","Selecciona directorio fenotipo"),
textInput("cytopath", label="Directorio fenotipo", value=""),
textOutput("session"), textOutput("session"),
hr(), hr(),
actionButton("fcsconvert", "Convertir a fcs"), actionButton("fcsconvert", "Convertir a fcs"),
@@ -145,37 +144,31 @@ server <- function(input, output) {
print(CCfile) print(CCfile)
if (input$dbtype == "UM"){ if (input$dbtype == "UM"){
dta<<-odbcConnectAccess2007(access.file = UMfile, dta<<-odbcConnectAccess2007(access.file = UMfile,
pwd = .rs.askForPassword("Enter password:")) pwd = getPass::getPass("Enter password:"))
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
dta<<-odbcConnectAccess2007(access.file = OVfile, dta<<-odbcConnectAccess2007(access.file = OVfile,
pwd = .rs.askForPassword("Enter password:")) pwd = getPass::getPass("Enter password:"))
} }
if (input$dbtype == "CC"){ if (input$dbtype == "CC"){
dta<<-odbcConnectAccess2007(access.file = CCfile, dta<<-odbcConnectAccess2007(access.file = CCfile,
pwd = .rs.askForPassword("Enter password:")) pwd = getPass::getPass("Enter password:"))
} }
print(dta) print(dta)
if (input$backup == T){ if (input$backup == T){
if (! input$dbtype %in% c("UM","OV")){ if (! input$dbtype %in% c("UM","OV")){
sqlBackUp(bu.dir="CC_BU") sqlBackUp(dbfile = CCfile, bu.dir="CC_BU")
}else{
sqlBackUp()
} }
if (input$dbtype == "UM"){
sqlBackUp(dbfile = UMfile)
}
if (input$dbtype == "OV"){
sqlBackUp(dbfile = OVfile)
}
print("Back up realizado.")
} }
}) })
# observe({
# if (!is.null(input$file_access)){
# # Inicializar conexión
# dta<<-odbcConnectAccess2007(access.file = file,
# pwd = .rs.askForPassword("Enter password:"))
# print(dta)
# sqlBackUp()
# }
# })
observe({ observe({
if (!is.null(input$file_query)){ if (!is.null(input$file_query)){
## Importamos los NHC de las muestras nuevas ## Importamos los NHC de las muestras nuevas
@@ -300,13 +293,13 @@ server <- function(input, output) {
} }
if (input$dbtype == "UM"){ if (input$dbtype == "UM"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID")) values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID", as.is=T))
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID")) values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID", as.is=T))
} }
if (input$dbtype == "CC"){ if (input$dbtype == "CC"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "PATID")) values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "PATID", as.is=T))
} }
print(values[["DF"]]) print(values[["DF"]])
}) })
@@ -314,9 +307,9 @@ server <- function(input, output) {
observeEvent(input$filltemplate,{ observeEvent(input$filltemplate,{
today=T today=T
if (input$dbtype == "UM"){ if (input$dbtype == "UM"){
upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) upd.umid<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras ## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS") samples<-sqlFetch(dta, "MUESTRAS", as.is=T)
if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){ if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){
next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1 next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1
}else{ }else{
@@ -324,7 +317,7 @@ server <- function(input, output) {
} }
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO) new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID", as.is=T), all.x=T) %>% arrange(CODIGO)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
if (today==TRUE){ if (today==TRUE){
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
@@ -334,30 +327,30 @@ server <- function(input, output) {
if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){
nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"]
umid.cnag<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID) umid.cnag<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID)
sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO) sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO)
cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T) cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG", as.is=T) %>% slice(0), all=T)
if (today==TRUE){ if (today==TRUE){
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
} }
}else{ }else{
cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>% cnag.exp<-sqlFetch(dta, "CNAG", as.is=T) %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){
nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"]
umid.rna<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID) umid.rna<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% nhcs.rna) %>% pull(UMID)
sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO) sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO)
rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0)%>% rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0)%>%
mutate(across(lubridate::is.POSIXct, as.character)), all=T) mutate(across(lubridate::is.POSIXct, as.character)), all=T)
}else{ }else{
rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>% rna.exp<-sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICOS") upd.clinics<-sqlFetch(dta, "CLINICOS", as.is=T)
umid.new<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) umid.new<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID") upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID")
upd.clinics$NHC<-as.character(upd.clinics$NHC) upd.clinics$NHC<-as.character(upd.clinics$NHC)
for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])} for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
@@ -368,9 +361,9 @@ server <- function(input, output) {
values[["rna"]]<-rna.exp values[["rna"]]<-rna.exp
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
upd.umid<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC) upd.umid<-sqlFetch(dta, "OVID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras ## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "SAMPLES") samples<-sqlFetch(dta, "SAMPLES", as.is=T)
if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){ if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){
next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1 next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1
}else{ }else{
@@ -378,17 +371,17 @@ server <- function(input, output) {
} }
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID"), all.x=T) %>% arrange(samples) new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID", as.is=T), all.x=T) %>% arrange(samples)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
if (today==TRUE){ 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"]] nhc.table<-values[["DF"]]
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICS") upd.clinics<-sqlFetch(dta, "CLINICS", as.is=T)
umid.new<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC) umid.new<-sqlFetch(dta, "OVID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID") upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID")
upd.clinics$NHC<-as.character(upd.clinics$NHC) upd.clinics$NHC<-as.character(upd.clinics$NHC)
for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])} for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
@@ -398,9 +391,9 @@ server <- function(input, output) {
} }
if (input$dbtype %in% c("CC")){ if (input$dbtype %in% c("CC")){
upd.umid<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC) upd.umid<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras ## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS") samples<-sqlFetch(dta, "MUESTRAS", as.is=T)
if(sum(grepl(paste0(input$dbtype,Sys.time() %>% format("%y")), samples$CODIGO)) > 0){ if(sum(grepl(paste0(input$dbtype,Sys.time() %>% format("%y")), samples$CODIGO)) > 0){
next.samp<-gsub(paste0(input$dbtype,Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1 next.samp<-gsub(paste0(input$dbtype,Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1
}else{ }else{
@@ -408,7 +401,7 @@ server <- function(input, output) {
} }
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("%s%s%02d",input$dbtype,Sys.time() %>% format("%y"),next.samp:last.samp) new.samp<-sprintf("%s%s%02d",input$dbtype,Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"PATID"), all.x=T) %>% arrange(CODIGO) new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"PATID", as.is=T), all.x=T) %>% arrange(CODIGO)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
if (today==TRUE){ if (today==TRUE){
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
@@ -418,30 +411,30 @@ server <- function(input, output) {
if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){
nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"]
umid.cnag<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.cnag) %>% pull(PATID) umid.cnag<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% nhcs.cnag) %>% pull(PATID)
sample.cnag<-samples.exp %>% filter(PATID %in% umid.cnag) %>% pull(CODIGO) sample.cnag<-samples.exp %>% filter(PATID %in% umid.cnag) %>% pull(CODIGO)
cnag.exp<-merge(data.frame("PATID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T) cnag.exp<-merge(data.frame("PATID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG", as.is=T) %>% slice(0), all=T)
if (today==TRUE){ if (today==TRUE){
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
} }
}else{ }else{
cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>% cnag.exp<-sqlFetch(dta, "CNAG", as.is=T) %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){
nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"]
umid.rna<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.rna) %>% pull(PATID) umid.rna<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% nhcs.rna) %>% pull(PATID)
sample.rna<-samples.exp %>% filter(PATID %in% umid.rna) %>% pull(CODIGO) sample.rna<-samples.exp %>% filter(PATID %in% umid.rna) %>% pull(CODIGO)
rna.exp<-merge(data.frame("PATID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0)%>% rna.exp<-merge(data.frame("PATID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0)%>%
mutate(across(lubridate::is.POSIXct, as.character)), all=T) mutate(across(lubridate::is.POSIXct, as.character)), all=T)
}else{ }else{
rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>% rna.exp<-sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICOS") upd.clinics<-sqlFetch(dta, "CLINICOS", as.is=T)
umid.new<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC) umid.new<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="PATID") upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="PATID")
upd.clinics$NHC<-as.character(upd.clinics$NHC) upd.clinics$NHC<-as.character(upd.clinics$NHC)
for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])} for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
@@ -474,8 +467,8 @@ server <- function(input, output) {
## Entradas modificadas en CLINICOS ## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]] upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(UMID))]
rnames<-sqlFetch(dta, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames rnames<-sqlFetch(dta, "CLINICOS", as.is=T) %>% filter(UMID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC) clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames rownames(clinics.mod)<-rnames
@@ -488,8 +481,8 @@ server <- function(input, output) {
print("Tabla CLINICOS modificada.") print("Tabla CLINICOS modificada.")
## Nuevas entradas en CLINICOS ## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow nsamples.clin<-sqlFetch(dta, "CLINICOS", as.is=T) %>% nrow
umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(UMID))]
clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC) clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC)
if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
@@ -506,7 +499,7 @@ server <- function(input, output) {
## Nuevas entradas en CNAG ## Nuevas entradas en CNAG
if (nrow(values[["cnag"]]) > 0){ if (nrow(values[["cnag"]]) > 0){
cnag.sync<-values[["cnag"]] cnag.sync<-values[["cnag"]]
fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG", as.is=T) %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
print(fechas) print(fechas)
@@ -519,7 +512,7 @@ server <- function(input, output) {
## Nuevas entradas en RNADNA ## Nuevas entradas en RNADNA
if (nrow(values[["rna"]]) > 0){ if (nrow(values[["rna"]]) > 0){
rna.sync<-values[["rna"]] rna.sync<-values[["rna"]]
fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA", as.is=T) %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
for (i in fechas){ for (i in fechas){
@@ -535,7 +528,7 @@ server <- function(input, output) {
if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
if (nrow(upd.samples) > 0){ if (nrow(upd.samples) > 0){
fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES", as.is=T) %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){ for (i in fechas){
upd.samples[,i]<-lubridate::parse_date_time(upd.samples[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() upd.samples[,i]<-lubridate::parse_date_time(upd.samples[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
} }
@@ -550,14 +543,14 @@ server <- function(input, output) {
## Entradas modificadas en CLINICOS ## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]] upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS", as.is=T) %>% pull(OVID))]
rnames<-sqlFetch(dta, "CLINICS") %>% filter(OVID %in% umid.mod) %>% rownames rnames<-sqlFetch(dta, "CLINICS", as.is=T) %>% filter(OVID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC) clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames rownames(clinics.mod)<-rnames
### !! Atención, esto cambia la base de datos: ### !! Atención, esto cambia la base de datos:
print(clinics.mod) print(clinics.mod)
fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS", as.is=T) %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){ for (i in fechas){
clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
} }
@@ -568,13 +561,13 @@ server <- function(input, output) {
print("Tabla CLINICS modificada.") print("Tabla CLINICS modificada.")
## Nuevas entradas en CLINICOS ## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICS") %>% nrow nsamples.clin<-sqlFetch(dta, "CLINICS", as.is=T) %>% nrow
umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS", as.is=T) %>% pull(OVID))]
clinics.new<-upd.clinics %>% filter(OVID %in% umid.new) %>% select(-NHC) clinics.new<-upd.clinics %>% filter(OVID %in% umid.new) %>% select(-NHC)
if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
### !! Atención, esto cambia la base de datos: ### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.new)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(clinics.new)[sqlFetch(dta, "CLINICS", as.is=T) %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){ for (i in fechas){
clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
} }
@@ -602,8 +595,8 @@ server <- function(input, output) {
## Entradas modificadas en CLINICOS ## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]] upd.clinics<-values[["CLINICS"]]
PATID.mod<-upd.clinics$PATID[upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS") %>% pull(PATID))] PATID.mod<-upd.clinics$PATID[upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(PATID))]
rnames<-sqlFetch(dta, "CLINICOS") %>% filter(PATID %in% PATID.mod) %>% rownames rnames<-sqlFetch(dta, "CLINICOS", as.is=T) %>% filter(PATID %in% PATID.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(PATID %in% PATID.mod) %>% select(-NHC) clinics.mod<-upd.clinics %>% filter(PATID %in% PATID.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames rownames(clinics.mod)<-rnames
@@ -616,8 +609,8 @@ server <- function(input, output) {
print("Tabla CLINICOS modificada.") print("Tabla CLINICOS modificada.")
## Nuevas entradas en CLINICOS ## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow nsamples.clin<-sqlFetch(dta, "CLINICOS", as.is=T) %>% nrow
PATID.new<-upd.clinics$PATID[!upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS") %>% pull(PATID))] PATID.new<-upd.clinics$PATID[!upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(PATID))]
clinics.new<-upd.clinics %>% filter(PATID %in% PATID.new) %>% select(-NHC) clinics.new<-upd.clinics %>% filter(PATID %in% PATID.new) %>% select(-NHC)
if (length(PATID.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} if (length(PATID.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
@@ -634,7 +627,7 @@ server <- function(input, output) {
## Nuevas entradas en CNAG ## Nuevas entradas en CNAG
if (nrow(values[["cnag"]]) > 0){ if (nrow(values[["cnag"]]) > 0){
cnag.sync<-values[["cnag"]] cnag.sync<-values[["cnag"]]
fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG", as.is=T) %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
print(fechas) print(fechas)
@@ -647,7 +640,7 @@ server <- function(input, output) {
## Nuevas entradas en RNADNA ## Nuevas entradas en RNADNA
if (nrow(values[["rna"]]) > 0){ if (nrow(values[["rna"]]) > 0){
rna.sync<-values[["rna"]] rna.sync<-values[["rna"]]
fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA", as.is=T) %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
for (i in fechas){ for (i in fechas){
@@ -755,6 +748,7 @@ server <- function(input, output) {
sqlFetch(dta, "NITROGEN"), sqlFetch(dta, "NITROGEN"),
file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","UM-Nitrogen.xlsx") 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")) table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
@@ -785,6 +779,7 @@ server <- function(input, output) {
sqlDrop(dta, "NITROGEN") sqlDrop(dta, "NITROGEN")
sqlSave(dta, table.um %>% select(-FECHA) %>% filter(!is.na(CODIGO)), tablename="NITROGEN", rownames=F) sqlSave(dta, table.um %>% select(-FECHA) %>% filter(!is.na(CODIGO)), tablename="NITROGEN", rownames=F)
print("Tabla Actualizada.")
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
## Copia de backup ## Copia de backup
@@ -798,6 +793,7 @@ server <- function(input, output) {
sqlFetch(dta, "NITROGEN"), sqlFetch(dta, "NITROGEN"),
file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","OV-Nitrogen.xlsx") file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","OV-Nitrogen.xlsx")
) )
print("Backup Creado.")
## Lectura del excel ## Lectura del excel
table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx")) table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
@@ -823,51 +819,151 @@ server <- function(input, output) {
sqlDrop(dta, "NITROGEN") sqlDrop(dta, "NITROGEN")
sqlSave(dta, table.ov, tablename="NITROGEN", rownames=F) sqlSave(dta, table.ov, tablename="NITROGEN", rownames=F)
print("Tabla Actualizada.")
} }
}) })
output$visorplot<-renderPlot({ output$visorplot<-renderPlot({
if (input$nhc == 3){ 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") pops<-sqlFetch(dta, "POPULATIONS")
g_pop<-pops %>% dplyr::filter(samples == input$id) %>% gather(pop,value,-samples) %>% g_pop<-pops %>%
mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells", dplyr::filter(sample == input$id) %>%
"CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>% 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))+ ggplot(aes(pop, value))+
geom_bar(stat="identity", color="black", fill="grey70")+ geom_bar(stat="identity", color="black", fill="grey70")+
labs(title = input$id, y="% parent", x="")+ labs(title = input$id, y="% parent", x="")+
theme_bw()+ theme_bw()+
theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5)) theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5))
tl<-sqlFetch(dta, "IC") %>% filter(samples == input$id) # tl<-sqlFetch(dta, "IC") %>% filter(samples == input$id)
#
mtl<-melt(tl, variable.name = "Receptors") # 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<-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("n","-",mtl$Receptors, fixed = T)
mtl$Receptors<-gsub("p","+",mtl$Receptors, fixed = T) # mtl$Receptors<-gsub("p","+",mtl$Receptors, fixed = T)
mtl$Receptors<-gsub("_"," ",mtl$Receptors) # mtl$Receptors<-gsub("_"," ",mtl$Receptors)
mtl[mtl$value < 1, "Receptors"]<-"Other" # mtl[mtl$value < 1, "Receptors"]<-"Other"
mtl$Receptors<-gsub("[A-Z]*-*[0-9T]- *", "", mtl$Receptors) # mtl$Receptors<-gsub("[A-Z]*-*[0-9T]- *", "", mtl$Receptors)
mtl$Receptors<-gsub("+ $", "", mtl$Receptors) # mtl$Receptors<-gsub("+ $", "", mtl$Receptors)
mtl$Receptors[mtl$Receptors == ""]<-"All Negative" # mtl$Receptors[mtl$Receptors == ""]<-"All Negative"
#
mtl$Receptors<-factor(mtl$Receptors) # mtl$Receptors<-factor(mtl$Receptors)
mtl$Population<-factor(mtl$Population, levels = c("CD8", "CD4")) # mtl$Population<-factor(mtl$Population, levels = c("CD8", "CD4"))
#
# colorCount<-length(unique(mtl$Receptors)) # # colorCount<-length(unique(mtl$Receptors))
# getPalette = colorRampPalette(RColorBrewer::brewer.pal(12, "Set3")) # # 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"), # 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+"="#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")) # 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))+ # g_IC<-ggplot(mtl, aes(samples, value, fill=Receptors))+
geom_bar(stat="summary", fun="sum",color="black")+ # geom_bar(stat="summary", fun="sum",color="black")+
labs(x="Patient", y="% CD8+", fill="")+ # labs(x="Patient", y="% CD8+", fill="")+
facet_grid(.~Population)+ # facet_grid(.~Population)+
scale_fill_manual(values = color[levels(mtl$Receptors)[levels(mtl$Receptors) %in% unique(mtl$Receptors)]])+ # scale_fill_manual(values = color[levels(mtl$Receptors)[levels(mtl$Receptors) %in% unique(mtl$Receptors)]])+
theme_bw()+ # theme_bw()+
theme(axis.text.x=element_text(angle=45, hjust=1)) # theme(axis.text.x=element_text(angle=45, hjust=1))
ggpubr::ggarrange(g_pop, g_IC, heights = c(0.4, 0.6), ncol = 1) ggpubr::ggarrange(g_pop, g_IC, heights = c(0.4, 0.6), ncol = 1)
} }
}) })
@@ -877,7 +973,11 @@ server <- function(input, output) {
observe({ observe({
if(input$goButtonDir > 0){ if(input$goButtonDir > 0){
if (input$cytopath == ""){
cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) %>% paste0("/") cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) %>% paste0("/")
}else{
cito_dir<<-input$cytopath %>% gsub("\\","/",. ,fixed=T) %>% gsub("/$", "", .) %>% paste0("/")
}
output$session <- renderText( output$session <- renderText(
cito_dir cito_dir
@@ -916,7 +1016,7 @@ server <- function(input, output) {
} }
if (input$phenotype == "IC"){ if (input$phenotype == "IC"){
route<-cito_dir route<-stringi::stri_enc_tonative(cito_dir)
ws<-open_flowjo_xml(paste0(route,"IC.wsp")) ws<-open_flowjo_xml(paste0(route,"IC.wsp"))
gs<-flowjo_to_gatingset(ws, name="All Samples") gs<-flowjo_to_gatingset(ws, name="All Samples")
@@ -924,25 +1024,178 @@ server <- function(input, output) {
sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "ICs ")[[1]][2]) %>% sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "ICs ")[[1]][2]) %>%
gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T) 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() 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<-gs_get_pop_paths(gs)
nodes_parent<-nodes[!grepl("CTLA4|LAG3|PD1|TIGIT|TIM3|root$", nodes)] 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_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)] nodes_cd8<-nodes[grepl("CTLA4$|LAG3$|PD1$|TIGIT$|TIM3$", nodes) & grepl("/CD8/",nodes)]
for (id in names){ # g1<-ggcyto_arrange(autoplot(gs[[ab]], nodes_parent, bins=128), nrow=1)
print(id) # g2<-ggcyto_arrange(autoplot(gs[[iso]], nodes_cd8, bins=64), nrow=1)
iso<-sampleNames(gs)[grepl(id, sampleNames(gs)) & grepl("iso",sampleNames(gs))] # g3<-ggcyto_arrange(autoplot(gs[[ab]], nodes_cd8, bins=64), nrow=1)
ab<-sampleNames(gs)[grepl(id, sampleNames(gs)) & grepl("ab",sampleNames(gs))] # 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)
g1<-ggcyto_arrange(autoplot(gs[[ab]], nodes_parent, bins=128), nrow=1) g_all<-ggpubr::ggarrange(g_dots, g_coex, nrow=1, widths=c(0.65,0.35))
g2<-ggcyto_arrange(autoplot(gs[[iso]], nodes_cd8, bins=64), nrow=1) ggsave(paste0(route,id,".IC.png"), g_all, width = 14, height = 10)
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)
} }
} }
}) })
@@ -987,17 +1240,47 @@ server <- function(input, output) {
sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "ICs ")[[1]][2]) %>% sampleNames(gs)<-sapply(sampleNames(gs), function(x) strsplit(x, "ICs ")[[1]][2]) %>%
gsub("[[:space:]][0-9]*.fcs_.[0-9]*","", . , perl = T) 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<-gs_get_pop_paths(gs)
# nodes<-gsub("â\u0081»", "-", nodes) # nodes<-gsub("â\u0081»", "-", nodes)
# nodes<-gsub("â\u0081º", "+", nodes) # nodes<-gsub("â\u0081º", "+", nodes)
nodes<-nodes[grepl("CTLA4", 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)] 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<-gs_pop_get_stats(gs, nodes=nodes,type="percent") %>% as.data.frame %>% mutate(percent=percent*100)
pop$percent<-round(pop$percent, digits=2) pop$percent<-round(pop$percent, digits=2)
pop$pop<-gsub("â\u0081»", "n", pop$pop) # pop$pop<-gsub("â\u0081»", "n", pop$pop)
pop$pop<-gsub("â\u0081º", "p", 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$pop<-gsub(" ", "_", pop$pop)
pop["Type"]<-"ab" pop["Type"]<-"ab"
@@ -1012,12 +1295,28 @@ server <- function(input, output) {
pop_sp$pop<-sapply(strsplit(pop_sp$pop, "/"), tail, 1) pop_sp$pop<-sapply(strsplit(pop_sp$pop, "/"), tail, 1)
pop_sp<-pop_sp %>% select(-ab,-iso) %>% spread(pop,Net) 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) %>% 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) gather(pop, value, -sample,-Population) %>% summarise(n=100-sum(value)) %>% pull(n)
if (input$dbtype == "OV"){
pop_sp <- rename(pop_sp, "samples"="sample") 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) vartypes<-rep("Number", pop_sp %>% select(-samples, -Population) %>% colnames %>% length)
names(vartypes)<-pop_sp %>% select(-samples, -Population) %>% colnames 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) sqlSave(dta, pop_sp, tablename="IC", append = T, varTypes = vartypes, rownames = F)
print("Tabla IC sincronizada.") print("Tabla IC sincronizada.")
sqlFunctions.R
+7 -5
View File
@@ -15,7 +15,7 @@ sqlLastDrop<-function(conn, tablename, droplast=1,dbtype=NULL){
sqlInitialize<-function(ruta="ruta_database.R"){ sqlInitialize<-function(ruta="ruta_database.R"){
library(tidyverse) # library(tidyverse)
library(RODBC) library(RODBC)
library(openxlsx) library(openxlsx)
@@ -24,10 +24,12 @@ sqlInitialize<-function(ruta="ruta_database.R"){
} }
sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){ sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){
print(dbfile)
if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"} if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"}
if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"} if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"}
db=strsplit(dbfile, "/")[[1]]%>% tail(n=1) db=tail(strsplit(dbfile, "/")[[1]], n=1)
print(db)
bu_path<-gsub(db,bu.dir,dbfile) bu_path<-gsub(db,bu.dir,dbfile)
if (!dir.exists(bu_path)){ if (!dir.exists(bu_path)){
dir.create(bu_path) dir.create(bu_path)
@@ -75,12 +77,12 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
db<-c("dbcode"="PATID", "dbpref"="CCID") db<-c("dbcode"="PATID", "dbpref"="CCID")
} }
dbid<-sqlFetch(conn,db["dbcode"]) dbid<-sqlFetch(conn,db["dbcode"], as.is=T)
new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique() new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique()
if(length(new.nhc) > 0){ if(length(new.nhc) > 0){
if (nrow(dbid) == 0){next.num<-1}else{ if (nrow(dbid) == 0){next.num<-1}else{
next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1 next.num<-gsub(db["dbpref"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
} }
print(next.num) print(next.num)
last.num<-next.num+(length(new.nhc)-1) last.num<-next.num+(length(new.nhc)-1)
@@ -91,7 +93,7 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
if(dbtype=="UM"){ if(dbtype=="UM"){
dbid<-merge(dbid, newtab, all=T) %>% select(NHC,UMID) %>% arrange(UMID) dbid<-merge(dbid, newtab, all=T) %>% select(NHC,UMID) %>% arrange(UMID)
# dbid$Id<-as.numeric(rownames(dbid)) # dbid$Id<-as.numeric(rownames(dbid))
dbid$NHC<-as.numeric(dbid$NHC) # dbid$NHC<-dbid$NHC
} }
if (dbtype=="CC"){ if (dbtype=="CC"){
dbid<-merge(dbid, newtab, all=T) %>% select(NHC,PATID) %>% arrange(PATID) dbid<-merge(dbid, newtab, all=T) %>% select(NHC,PATID) %>% arrange(PATID)