marcelcosta
/
BDAccess
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity
Scripts relacionados con el acceso y análisis en bases de datos Access.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
72 Commits
2 Branches
5.5 MiB
 
Tree: 67ba4921ca
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from '67ba4921ca'
${ noResults }
BDAccess/BDAccess/app.R

985 lines
42 KiB
Raw Blame History

library(shiny)
library(rhandsontable)
library(tidyverse)
library(reshape2)
library(Matrix)
library(CitFuns)
library(BDCIT)
library(openCyto)
library(flowCore)
library(flowWorkspace)
library(CytoML)
print(getwd())
source("../sqlFunctions.R", encoding = "UTF-8")
DF<-data.frame("NHC"="","Samples"="")
samples<-data.frame("UMID"="","UM"="")
CLINICS<-data.frame("UMID"="","UM"="")
cnag<-data.frame("UMID"="","UM"="")
rna<-data.frame("UMID"="","UM"="")
# Cargar dependencias
sqlInitialize(ruta="../ruta_database.R")
# UI ----
ui <- fluidPage(
# Application title
#titlePanel("BDAccess"),
#sidebarLayout(
#Navbar
navbarPage("BDAccess",
## Update ----
tabPanel("Update",
sidebarPanel(
selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")),
checkboxInput(inputId = "backup", label="Backup", value=F),
actionButton("butdbtype", "Carrega BD"),
hr(),
fileInput(inputId = "file_query", label = "Plantilla", multiple = F),
actionButton("impNHC", "Importa NHC"),
actionButton("goButton", "Genera PATID"),
hr(),
actionButton("filltemplate", "Plantilla"),
hr(),
actionButton("synctemplate", "Sincronizar")
),
mainPanel(
tabsetPanel(
tabPanel("NHC", rHandsontableOutput("hot")),
tabPanel("Samples",rHandsontableOutput("samples")),
tabPanel("CLINICS",rHandsontableOutput("CLINICS")),
tabPanel("CNAG",rHandsontableOutput("cnag")),
tabPanel("RNADNA",rHandsontableOutput("rna")),
)
)
),
## Visor ----
tabPanel("Visor",
sidebarPanel(
radioButtons("nhc", label = h3("Código"),
choices = list("NHC" = 1, "UMID/OVID" = 2, "UM/OV"=3),
selected = 2),
textInput("id", label = "ID", value = ""),
actionButton("nitrosync", "Actualiza Nitrógeno")
),
mainPanel(
htmlOutput("report"),
h3("Nitrogen"),
tableOutput("nitrogen")
)
),
## Citometría ----
tabPanel("Citometría",
sidebarPanel(
selectInput("phenotype", "Tipo de análisis", selected="Pop", choices=c("Pop", "IC")),
),
mainPanel(
actionButton("goButtonDir","Selecciona directorio fenotipo"),
textOutput("session"),
hr(),
actionButton("fcsconvert", "Convertir a fcs"),
hr(),
actionButton("pngexport", "Exportar informes"),
actionButton("popexport", "Actualizar BBDD")
)
),
## 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 ----
values <- reactiveValues()
values[["DF"]]<-DF
values[["samples"]]<-samples
values[["CLINICS"]]<-CLINICS
values[["cnag"]]<-cnag
values[["rna"]]<-rna
values[["Excel"]]<-""
observeEvent(input$butdbtype, {
print(UMfile)
print(OVfile)
print(CCfile)
if (input$dbtype == "UM"){
dta<<-odbcConnectAccess2007(access.file = UMfile,
pwd = .rs.askForPassword("Enter password:"))
}
if (input$dbtype == "OV"){
dta<<-odbcConnectAccess2007(access.file = OVfile,
pwd = .rs.askForPassword("Enter password:"))
}
if (input$dbtype == "CC"){
dta<<-odbcConnectAccess2007(access.file = CCfile,
pwd = .rs.askForPassword("Enter password:"))
}
print(dta)
if (input$backup == T){
if (! input$dbtype %in% c("UM","OV")){
sqlBackUp(bu.dir="CC_BU")
}else{
sqlBackUp()
}
}
})
# observe({
# if (!is.null(input$file_access)){
# # Inicializar conexión
# dta<<-odbcConnectAccess2007(access.file = file,
# pwd = .rs.askForPassword("Enter password:"))
# print(dta)
# sqlBackUp()
# }
# })
observe({
if (!is.null(input$file_query)){
## Importamos los NHC de las muestras nuevas
values[["Excel"]]<-read.xlsx(input$file_query$datapath, sheet = "NHC") %>% pull(NHC) %>% as.character()
print(values[["Excel"]])
}
})
observeEvent(input$impNHC, {
values[["DF"]]<-merge(values[["DF"]], data.frame("NHC"=values[["Excel"]]), all.y=T)
})
## Handsontable
observe({
if (!is.null(input$hot)) {
DF = hot_to_r(input$hot)
} else {
if (is.null(values[["DF"]])){
DF <- DF
}
else{
DF <- values[["DF"]]
}
}
values[["DF"]] <- DF
})
output$hot <- renderRHandsontable({
if (!is.null(DF)){
rhandsontable(values[["DF"]], stretchH = "all", readOnly = F, useTypes = T)
}
})
observe({
if (!is.null(input$samples)) {
samples = hot_to_r(input$samples)
} else {
if (is.null(values[["samples"]])){
samples <- samples
}
else{
samples <- values[["samples"]]
}
}
values[["samples"]] <- samples
})
output$samples <- renderRHandsontable({
if (!is.null(samples)){
rhandsontable(values[["samples"]], stretchH = "all", readOnly = F, useTypes = T)
}
})
observe({
if (!is.null(input$CLINICS)) {
CLINICS = hot_to_r(input$CLINICS)
} else {
if (is.null(values[["CLINICS"]])){
CLINICS <- CLINICS
}
else{
CLINICS <- values[["CLINICS"]]
}
}
values[["CLINICS"]] <- CLINICS
})
output$CLINICS <- renderRHandsontable({
if (!is.null(CLINICS)){
rhandsontable(values[["CLINICS"]], stretchH = "all", readOnly = F, useTypes = T) %>%
hot_col(values[["CLINICS"]] %>% select(lubridate::is.Date) %>% colnames,
dateFormat = "DD/MM/YYYY", type = "date")
}
})
observe({
if (!is.null(input$cnag)) {
cnag = hot_to_r(input$cnag)
} else {
if (is.null(values[["cnag"]])){
cnag <- cnag
}
else{
cnag <- values[["cnag"]]
}
}
values[["cnag"]] <- cnag
})
output$cnag <- renderRHandsontable({
if (!is.null(cnag)){
rhandsontable(values[["cnag"]], stretchH = "all", readOnly = F, useTypes = T)
}
})
observe({
if (!is.null(input$rna)) {
rna = hot_to_r(input$rna)
} else {
if (is.null(values[["rna"]])){
rna <- rna
}
else{
rna <- values[["rna"]]
}
}
values[["rna"]] <- rna
})
output$rna <- renderRHandsontable({
if (!is.null(rna)){
rhandsontable(values[["rna"]], stretchH = "all", readOnly = F, useTypes = T)
}
})
observeEvent(input$goButton, {
if (input$dbtype %in% c("UM","OV")){
sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T)
}
if (input$dbtype %in% c("CC")){
sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T, dbtype = input$dbtype)
}
if (input$dbtype == "UM"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID"))
}
if (input$dbtype == "OV"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID"))
}
if (input$dbtype == "CC"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "PATID"))
}
print(values[["DF"]])
})
observeEvent(input$filltemplate,{
today=T
if (input$dbtype == "UM"){
upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS")
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
}else{
next.samp<-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.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
if (today==TRUE){
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
}
nhc.table<-values[["DF"]]
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"]
umid.cnag<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID)
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)
if (today==TRUE){
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
}
}else{
cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character))
}
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"]
umid.rna<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID)
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)%>%
mutate(across(lubridate::is.POSIXct, as.character)), all=T)
}else{
rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character))
}
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICOS")
umid.new<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID")
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])}
values[["samples"]]<-samples.exp
values[["CLINICS"]]<-upd.clinics
values[["cnag"]]<-cnag.exp
values[["rna"]]<-rna.exp
}
if (input$dbtype == "OV"){
upd.umid<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "SAMPLES")
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
}else{
next.samp<-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.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")
}
nhc.table<-values[["DF"]]
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICS")
umid.new<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID")
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])}
values[["samples"]]<-samples.exp %>% mutate(across(lubridate::is.POSIXct, as.character))
values[["CLINICS"]]<-upd.clinics %>% mutate(across(lubridate::is.POSIXct, as.character))
}
if (input$dbtype %in% c("CC")){
upd.umid<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS")
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
}else{
next.samp<-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.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"PATID"), all.x=T) %>% arrange(CODIGO)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
if (today==TRUE){
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
}
nhc.table<-values[["DF"]]
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"]
umid.cnag<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.cnag) %>% pull(PATID)
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)
if (today==TRUE){
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
}
}else{
cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character))
}
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"]
umid.rna<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.rna) %>% pull(PATID)
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)%>%
mutate(across(lubridate::is.POSIXct, as.character)), all=T)
}else{
rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character))
}
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICOS")
umid.new<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="PATID")
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])}
values[["samples"]]<-samples.exp
values[["CLINICS"]]<-upd.clinics
values[["cnag"]]<-cnag.exp
values[["rna"]]<-rna.exp
}
})
observeEvent(input$synctemplate,{
if (input$dbtype == "UM"){
# conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL
## Nuevas entradas en MUESTRAS
nsamples<-values[["samples"]] %>% nrow
upd.samples<-values[["samples"]]
if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
if (nrow(upd.samples) > 0){
upd.samples$FECHA_RECEPCION<-lubridate::parse_date_time(upd.samples$FECHA_RECEPCION, c("d/m/Y","d/m/y")) %>% as.Date()
upd.samples$TIPO<-as.character(upd.samples$TIPO)
upd.samples$OBS<-as.character(upd.samples$OBS)
### !! Atención, esto cambia la base de datos:
sqlSave(dta, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F)
print("Tabla MUESTRAS sincronizada.")
}
## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
rnames<-sqlFetch(dta, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames
### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)]
for (i in fechas){
clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y")) %>% as.Date()
}
sqlUpdate(dta, clinics.mod,"CLINICOS", index="UMID")
print("Tabla CLINICOS modificada.")
## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow
umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
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}
### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)]
varTypes<-rep("Date",length(fechas))
names(varTypes)<-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()
}
sqlSave(dta, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F)
print("Tabla CLINICOS sincronizada.")
## Nuevas entradas en CNAG
if (nrow(values[["cnag"]]) > 0){
cnag.sync<-values[["cnag"]]
fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
print(fechas)
for (i in fechas){
cnag.sync[,i]<-lubridate::parse_date_time(cnag.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, cnag.sync, tablename="CNAG", append = T, varTypes = varTypes, rownames = F)
}
## Nuevas entradas en RNADNA
if (nrow(values[["rna"]]) > 0){
rna.sync<-values[["rna"]]
fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
for (i in fechas){
rna.sync[,i]<-lubridate::parse_date_time(rna.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, rna.sync, tablename="RNADNA", append = T, varTypes = varTypes, rownames = F)
}
}
if (input$dbtype == "OV"){
## Nuevas entradas en SAMPLES
nsamples<-values[["samples"]] %>% nrow
upd.samples<-values[["samples"]]
if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
if (nrow(upd.samples) > 0){
fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES") %>% sapply(lubridate::is.POSIXct)]
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()
}
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
# upd.samples$TIPO<-as.character(upd.samples$TIPO)
# upd.samples$OBS<-as.character(upd.samples$OBS)
### !! Atención, esto cambia la base de datos:
sqlSave(dta, upd.samples, tablename="SAMPLES", append = T, varTypes = varTypes, rownames = F)
print("Tabla SAMPLES sincronizada.")
}
## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
rnames<-sqlFetch(dta, "CLINICS") %>% filter(OVID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames
### !! Atención, esto cambia la base de datos:
print(clinics.mod)
fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)]
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()
}
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
print(clinics.mod)
sqlUpdate(dta, clinics.mod,"CLINICS", index="OVID")
print("Tabla CLINICS modificada.")
## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICS") %>% nrow
umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
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}
### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.new)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)]
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()
}
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
print(varTypes)
print(clinics.new)
sqlSave(dta, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes, rownames = F)
print("Tabla CLINICS sincronizada.")
}
if (input$dbtype %in% c("CC")){
## Nuevas entradas en MUESTRAS
nsamples<-values[["samples"]] %>% nrow
upd.samples<-values[["samples"]]
if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
if (nrow(upd.samples) > 0){
upd.samples$FECHA_RECEPCION<-lubridate::parse_date_time(upd.samples$FECHA_RECEPCION, c("d/m/Y","d/m/y")) %>% as.Date()
upd.samples$TIPO<-as.character(upd.samples$TIPO)
upd.samples$OBS<-as.character(upd.samples$OBS)
### !! Atención, esto cambia la base de datos:
sqlSave(dta, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F)
print("Tabla MUESTRAS sincronizada.")
}
## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]]
PATID.mod<-upd.clinics$PATID[upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS") %>% pull(PATID))]
rnames<-sqlFetch(dta, "CLINICOS") %>% filter(PATID %in% PATID.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(PATID %in% PATID.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames
### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)]
for (i in fechas){
clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y")) %>% as.Date()
}
sqlUpdate(dta, clinics.mod,"CLINICOS", index="PATID")
print("Tabla CLINICOS modificada.")
## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow
PATID.new<-upd.clinics$PATID[!upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS") %>% pull(PATID))]
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}
### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)]
varTypes<-rep("Date",length(fechas))
names(varTypes)<-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()
}
sqlSave(dta, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F)
print("Tabla CLINICOS sincronizada.")
## Nuevas entradas en CNAG
if (nrow(values[["cnag"]]) > 0){
cnag.sync<-values[["cnag"]]
fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
print(fechas)
for (i in fechas){
cnag.sync[,i]<-lubridate::parse_date_time(cnag.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, cnag.sync, tablename="CNAG", append = T, varTypes = varTypes, rownames = F)
}
## Nuevas entradas en RNADNA
if (nrow(values[["rna"]]) > 0){
rna.sync<-values[["rna"]]
fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
for (i in fechas){
rna.sync[,i]<-lubridate::parse_date_time(rna.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, rna.sync, tablename="RNADNA", append = T, varTypes = varTypes, rownames = F)
}
}
})
## Visor ----
output$report<-renderUI({
samples<-sqlFetch(dta, "samples")
if (input$nhc == 1){samples_sel<-samples %>% filter(OVID == input$id)}
if (input$nhc == 2){samples_sel<-samples %>% filter(OVID == input$id)}
if (input$nhc == 3){samples_sel<-samples %>% filter(samples == input$id)}
print(input$id)
print(samples_sel)
if (input$nhc == 3){
HTML(paste0(
"
<style>
table {
font-family: Arial, Helvetica, sans-serif;
border-collapse: collapse;
width: 100%;
}
table td, table th {
border: 1px solid #ddd;
padding: 8px;
}
table tr:nth-child(even){background-color: #f2f2f2;}
table tr:hover {background-color: #ddd;}
table th {
padding-top: 12px;
padding-bottom: 12px;
text-align: left;
background-color: #04AA6D;
color: white;
}
</style>
",
"<h3>Muestra: ",input$id,"</h3>",
"<b>OVID</b>: ",samples_sel$OVID,"<br>",
"<b>Fecha</b>: ",samples_sel$IQ_date,"<br>",
"<b>Tipo de tejido: </b>",samples_sel$Tissue,"<br><br>",
"<b>AP: </b>",samples_sel$AP,"<br><br>",
"<b>Comments:</b>","<br> ",samples_sel$Coments,"<br><br>",
"<table style='width:auto;'>
<tg>
<th><b>Hist</b></th>
<th><b>RNA</b></th>
<th><b>Slide</b></th>
<th><b>Frag</b></th>
<th><b>Disg</b></th>
</tr>
<tr>
<td>",samples_sel$Hist_dic,"</td>
<td>",samples_sel$RNA_dic,"</td>
<td>",samples_sel$Slide_dic,"</td>
<td>",samples_sel$Frag_vial,"</td>
<td>",samples_sel$Disg_vial,"</td>
"
))
}
#**AP**: `r samples_sel$AP`
#**Macro**:
# `r samples_sel$Macro`
#**Despcripción**:
# `r samples_sel$Description`
#**Procesado**:
# `r samples_sel$Process`
})
output$nitrogen<-renderTable({
nitro<-sqlFetch(dta, "NITROGEN")
if (input$nhc == 3){nitro<-nitro %>% filter(CODIGO == input$id)}
else{nitro<-as.data.frame(matrix(ncol=0, nrow=0))}
nitro
})
observeEvent(input$nitrosync, {
if (input$dbtype == "UM"){
## Copia de backup
if (!dir.exists(NitroRoute)){
dir.create(NitroRoute)
print(paste0("Back Up directory ", NitroRoute, " created"))
}
write.xlsx(
sqlFetch(dta, "NITROGEN"),
file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","UM-Nitrogen.xlsx")
)
table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
table.um<-table %>% filter( grepl("UM|MU", Nombre) | grepl("Met|Prim|hep|Enn",Nombre, ignore.case = T) |
Nombre == "TILs f. 21/09/20" | Nombre == "TILS DISG f. 03/07/20")
table.um<-add_column(table.um,.before=1, "CODIGO"=str_extract(table.um$Nombre, "UM[0-9]{4}"))
table.samp<-sqlQuery(dta, "SELECT U.NHC,M.* FROM MUESTRAS M INNER JOIN UMID U ON M.UMID=U.UMID")
table.samp$FECHA_RECEPCION<-table.samp$FECHA_RECEPCION+24*60*60
table.um<-add_column(table.um, .after=1,
"FECHA"=str_extract(table.um$Nombre, "[0-9]{2}[\\./][0-9]{2}[\\./][0-9]{2}") %>% gsub("\\.","/",.))
table.um$FECHA<-as.POSIXct(table.um$FECHA, format="%d/%m/%y")
table.um<-merge(table.um, table.samp %>% select(CODIGO,FECHA_RECEPCION), by.x="FECHA", by.y="FECHA_RECEPCION", all.x=T)
table.um<-table.um %>% mutate(CODIGO=case_when(is.na(CODIGO.x)~CODIGO.y, TRUE~CODIGO.x), .before=1) %>% select(-CODIGO.x,-CODIGO.y)
table.um[table.um$Nombre == "MU Met f. 10/02/20","CODIGO"]<-"UM0009"
table.um[table.um$Nombre == "TILs Diss Met","CODIGO"]<-"UM0020"
table.um[table.um$Nombre == "UM Met","CODIGO"]<-"UM0020"
table.um[table.um$Nombre == "UM MET NHC 11489341","CODIGO"]<-"UM0044"
table.um[table.um$Nombre == "UM Primary 20278822","CODIGO"]<-"UM0029"
table.um[table.um$Nombre == "Hip Nod Hep NHC11489341","CODIGO"]<-"UM0044"
## Actualización
sqlDrop(dta, "NITROGEN")
sqlSave(dta, table.um %>% select(-FECHA) %>% filter(!is.na(CODIGO)), tablename="NITROGEN", rownames=F)
}
if (input$dbtype == "OV"){
## Copia de backup
if (!dir.exists(NitroRoute)){
dir.create(NitroRoute)
print(paste0("Back Up directory ", NitroRoute, " created"))
}
write.xlsx(
sqlFetch(dta, "NITROGEN"),
file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","OV-Nitrogen.xlsx")
)
## Lectura del excel
table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
table.ov<-table %>% filter(grepl("OV",Nombre))
table.ov<-filter(table.ov, !grepl("OVA",Nombre))
table.ov<-add_column(table.ov,.before=1, "CODIGO"=str_extract(table.ov$Nombre, "OV[0-9]{4}"))
table.ov[table.ov$Nombre == "Ascitis OV","CODIGO"]<-"OV2105"
table.ov<-table.ov %>% add_column(SampType=NA, .after=1)
table.ov[grepl("TIL",table.ov$Nombre, ignore.case = T),"SampType"]<-"TILs"
table.ov[grepl("frag",table.ov$Nombre, ignore.case = T)|grepl("frag",table.ov$Observaciones, ignore.case = T),"SampType"]<-"FRAG"
table.ov[grepl("slide",table.ov$Nombre, ignore.case = T)|grepl("slide",table.ov$Observaciones, ignore.case = T),"SampType"]<-"SLIDE"
table.ov[(is.na(table.ov$SampType) | !(table.ov$SampType == "TILs")) &
(grepl("disg|diss",table.ov$Nombre, ignore.case = T)|
grepl("disg|diss",table.ov$Observaciones, ignore.case = T)),"SampType"]<-"DISG"
table.ov[table.ov$Nombre == "Ascitis OV", "SampType"]<-"ASC"
table.ov[20:25,"SampType"]<-"DISG"
table.ov[63:68,"SampType"]<-"DISG"
## Actualización
sqlDrop(dta, "NITROGEN")
sqlSave(dta, table.ov, tablename="NITROGEN", rownames=F)
}
})
## Citometría ----
observe({
if(input$goButtonDir > 0){
cito_dir<<-choose.dir() %>% gsub("\\","/",. ,fixed=T) %>% 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,{
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 ----
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
shinyApp(ui = ui, server = server)