empezando a modificar el script remoto

connection_parameters.R

@@ -73,7 +73,7 @@ resource_names <- c(
   "CIPH_numeric_derivated",
   "20220719_HarmonisedUMFIasi",
   "SMUC_resource",
-  "20220720_HarmonisedHM",
+  "20220919_FiHM",
   "Resource_derived",
   "IISFJD_Harmonized_1",
   "IPC_Harmonized",

valid_variables_script.R

 rm(list=ls())
 
-setwd("C:/Users/Victor/Documents/TFG/r-analytics-master")
+dir_name <- readline("Introduce the name of the directory please: ")
 
-source("required_folder_checker.R")
-source("argument_hasher.R")
-source("dependency_installer.R")
+setwd(dir_name)
 
-# install.packages("https://cran.r-project.org/src/contrib/Archive/DSI/DSI_1.2.0.tar.gz", repos=NULL, type="source")
-# install.packages("https://cran.r-project.org/src/contrib/Archive/DSOpal/DSOpal_1.2.0.tar.gz", repos=NULL, type="source")
-# install.packages("https://cran.r-project.org/src/contrib/Archive/DSLite/DSLite_1.2.0.tar.gz", repos=NULL, type="source")
-# install.packages("https://cran.r-project.org/src/contrib/Archive/opalr/opalr_2.1.0.tar.gz", repos=NULL, type="source")
+source("dependency_installer.R")
+source("connection_parameters.R")
+source("necessary_functions_connection.R")
+#source("required_folder_checker.R")
+#source("argument_hasher.R")
 
 
-dep_list = c("jsonlite", "stringr","DSI","DSOpal","DSLite", "fields", "metafor", "ggplot2", "gridExtra", "data.table", "dsBaseClient")
+dep_list = c("jsonlite", "stringr","DSI","DSOpal","DSLite", "fields", "metafor", "ggplot2", "gridExtra", "data.table", "dsBaseClient", "openxlsx")
 install_dependencies(dep_list)
 
-#,"DSI","DSOpal","DSLite"
+codebook_file <- "20220315_Data Harmonisation.xlsb.xlsx"
 
-setwd("C:/Users/victor/Documents/TFG/r-analytics-master")
-source("connection_parameters.R")
-source("necessary_functions_connection.R")
+codebook_demo <- read.xlsx(codebook_file , sheet = 2 )
+codebook_com_and_rf <- read.xlsx(codebook_file , sheet = 3 ) 
+
+codebook_home_med <- read.xlsx(codebook_file , sheet = 4 ) 
+codebook_si_sympt <- read.xlsx(codebook_file , sheet = 5 ) 
 
+codebook_treatments <- read.xlsx(codebook_file , sheet = 6 ) 
+codebook_labo <- read.xlsx(codebook_file , sheet = 7 ) 
 
-setwd("C:/Users/Victor/Documents/TFG/r-analytics-master/harmonised_data")
+codebook_complications <- read.xlsx(codebook_file , sheet = 8 ) 
+codebook_imaging_data <- read.xlsx(codebook_file , sheet = 9 ) 
 
+codebook_lifestyle_diet <- read.xlsx(codebook_file , sheet = 10 ) 
+codebook_dates <- read.xlsx(codebook_file , sheet = 11 )
 
-ComAndRF <- data.frame(read.csv("Com&RF.csv", sep=","))[1:64,1:5]
-Complications <- data.frame(read.csv("Complications.csv", sep=";"))[1:20,1:5]
-Dates <-  data.frame(read.csv("Dates.csv", sep=";"))[1:12,1:5]
-Demographics <-  data.frame(read.csv("Demographics.csv", sep=";"))[1:9,1:5]
-Home_med <-  data.frame(read.csv("Home_med.csv", sep=";"))[1:13,1:5]
-Imaging_data <-  data.frame(read.csv("Imaging_data.csv", sep=";"))[1:11,1:5]
-Labo <-  data.frame(read.csv("Labo.csv", sep=";"))[1:143,1:5]
-SiAndSympt <-  data.frame(read.csv("Si&Sympt.csv", sep=";"))[1:50,1:5]
-Treatment <-  data.frame(read.csv("Treatment.csv", sep=";"))[1:32,1:5]
-LifestyleAndDiet <-  data.frame(read.csv("Lifestyle&Diet.csv", sep=";"))[1:165,1:5]
+codebook <- rbind(codebook_demo , codebook_com_and_rf)
+codebook <- rbind(codebook , codebook_home_med)
+codebook <- rbind(codebook , codebook_si_sympt)
+codebook <- rbind(codebook , codebook_treatments)
+codebook <- rbind(codebook , codebook_labo)
+codebook <- rbind(codebook , codebook_complications)
+codebook <- rbind(codebook , codebook_imaging_data)
 
+codebook_lifestyle_diet <- codebook_lifestyle_diet[, !names(codebook_lifestyle_diet) %in% c("X2", "X4" , "X10")] 
+codebook <- rbind(codebook , codebook_lifestyle_diet)
+codebook <- rbind(codebook , codebook_dates)
 
 
-harmonised_data <- rbind(SiAndSympt,ComAndRF)
-harmonised_data <- rbind(harmonised_data,Treatment)
-harmonised_data <- rbind(harmonised_data,Dates)
-harmonised_data <- rbind(harmonised_data,Demographics)
-harmonised_data <- rbind(harmonised_data,Home_med)
-harmonised_data <- rbind(harmonised_data,Imaging_data)
-harmonised_data <- rbind(harmonised_data,Complications)
-harmonised_data <- rbind(harmonised_data,Labo)
-harmonised_data <- rbind(harmonised_data,LifestyleAndDiet)
+codebook_col_names <- as.data.frame(codebook$Harmonised.variable.name)
 
-rm(list=c("SiAndSympt",
-          "Complications",
-          "ComAndRF",
-          "Dates",
-          "Demographics",
-          "Home_med",
-          "Imaging_data",
-          "Complications",
-          "Labo",
-          "LifestyleAndDiet"))
+names(codebook_col_names) <- c("col_names")
 
 categoric_vars = c("DMRGENDR", "DMRBORN", "DMRRETH1", "DMROCCU", "DMRHREDU", "DSXOS", "DSXHO", "DSXIC", "TRXAV","TRXRIB","TRXLR","TRXRM","TRXIA","TRXIB","TRXCH","TRXAB","TRXCS","TRXHEP","TRXAF","TRXCP","TRXOT","TRXECM","TRXIV","TRXNIV","TRXNO","TRXOX","TRXRR","TRXTR","TRXVA","TRXPE","TRXPV","TRXIT","TRXNMB","TRXAC","TRXINA","TRXIS","TRXIM","TRXVC","TRXVD","TRXZN",                         "CSXCOT","CSXCTR","SMXASAH","SMXFEA","SMXCOA","SMXSTA","SMXSBA","SMXRNA","SMXMYA","SMXARA","SMXCPA","SMXAPA","SMXINA","SMXNAA","SMXDIA","SMXFAA","SMXHEA","SMXCNA","SMXACA","SMXSLA","SMXTLA","SMXSYA","SMXWHA","SMXLYA","SMXANA","SMXIWA","SMXSRA","SMXBLA","CMXPRG","CMXCVD","CMXCMP","CMXHT","CMXDI","CMXCKD","CMXCLD","CMXCPD","CMXASM","CMXCND","CMXRHE","CMXCCI","CMXCBD","CMXDE","CMXPU","CMXST","CMXLY","CMXAP","RFXSM","RFXFSM","RFXOB","RFXTB","RFXIMD","RFXHIV","RFXAIDS","RFXUI","RFXHC","RFXONC","RFXMN",                         "HMRACI","HMRARB","HMRAHO","HMRNS","HMROS","HMRCS","HMRIS","HMRAV","HMRAB","HMRCOV","IMDXCT","IMDXCTCR","IMDXCTTE","IMDXCTAB","IMDXXR","IMDXPN",                         "COXRD","COXAR","COXPM","COXMOD","COXPT","COXEC","COXSH","COXIO","COXPE","COXST","COXDIC","COXRIO","COXKF","COXHF","COXBC")
 
@@ -65,48 +54,41 @@ categoric_vars = c("DMRGENDR", "DMRBORN", "DMRRETH1", "DMROCCU", "DMRHREDU", "DS
 #----------------------------------------------------------------------------
 
 #Test if column names are valid
-check_column_names <- function(x){
+check_column_names <- function(codebook_param, colnames){
   
   str_res <- "The column names:"
+  valid_colnames <- c()
   
-  for(i in 1:(nrow(data_colnames))){
-    if(!check_valid_name(data_colnames[i,1])){
-      str_res<- paste(str_res, data_colnames[i,1], sep=" ")
+  for(i in 1:(nrow(colnames))){
+    colname <- colnames[i,1]
+    number_of_column <- check_valid_name(colname ,  colnames) 
+    if(number_of_column != 1){
+      str_res<- paste(str_res, colname, sep=" ")
+    }else{
+      valid_colnames <- c(valid_colnames, colname)
     }
   }
   
   str_res<- paste(str_res,"are not registered in the harmonized data codebook \n", sep=" ")
   
-  return (str_res)
+  result <- list("not_colnames" = str_res , "colnames" = valid_colnames)
   
+  return (result)
 }
 
 #Test if a single variable name is valid
-check_valid_name <- function(x){
-  
-  valid <- FALSE
-  
-  aux <- as.data.frame(strsplit(x , split = "_"))
+check_valid_name <- function(col_name , col_names){
   
-  if(aux[1,1] %in% harmonised_data$Harmonised.variable.name)
-    valid <- TRUE
+  valid <- 0
   
-  return (valid)
-  
-}
+  if(col_name %in% codebook_col_names$col_names){
     
-valid_data_colnames <- function(x){
+    valid <- length(grep(col_name, col_names))
     
-  valid_colnames = c()
-  
-  for(i in  1:(nrow(data_colnames))){
-    if(check_valid_name(data_colnames[i,1])){
-      valid_colnames = c(valid_colnames,data_colnames[i,1])
-    }
   }
   
+  return (valid)
   
-  return(valid_colnames)
 }
 
 remove_space <- function(x){
@@ -410,7 +392,7 @@ error_message <- function(colname, invalid_values){
   
 }
 
-check_valid_values <- function(){
+check_valid_values <- function(valid_colnames){
   
   invalid_name_list <- c()
   cannot_analyse_list <- c()
@@ -423,12 +405,14 @@ check_valid_values <- function(){
   
   for(i in  1:(nrow(valid_colnames))){
     
-    data_table ="empty"
-    
-    if(!grepl("DMRBORN",valid_colnames[i,1], fixed=TRUE) & (!grepl("DAT",valid_colnames[i,1], fixed=TRUE)) & (!grepl("ISO",valid_colnames[i,1], fixed=TRUE))& (!grepl("BEF",valid_colnames[i,1], fixed=TRUE))){
+    data_table <- "empty"
+    colname <- valid_colnames[i, 1]
     
+    if(grepl("DMRBORN",colname, fixed=TRUE) | (grepl("DAT",colname, fixed=TRUE)) | (grepl("ISO",colname, fixed=TRUE)) | (grepl("BEF", colname, fixed=TRUE))){
+      next 
+    }
     column <- "data$"
-      column <- paste(column, valid_colnames[i,1], sep="")
+    column <- paste(column, colname, sep="")
     
     tryCatch(
       error = function(cnd) {
@@ -440,7 +424,7 @@ check_valid_values <- function(){
     
     if(data_table == "empty"){
       
-        cannot_analyse_list <- c(cannot_analyse_list,valid_colnames[i,1])
+      cannot_analyse_list <- c(cannot_analyse_list, colname)
       
     }else{
       
@@ -450,57 +434,53 @@ check_valid_values <- function(){
       else
         values <- row.names(data_table)
       
-        numeric_col<- paste(valid_colnames[i,1],"_numeric", sep="")
+      numeric_col<- paste(colname,"_numeric", sep="")
       
-        if( valid_colnames[i,1] %in% categoric_vars ){
+      if( colname %in% categoric_vars ){
      
-          #is_numeric <- grepl("numeric",valid_colnames[i,1], fixed=TRUE)
         has_numeric <-  numeric_col %in% valid_colnames$`valid_data_colnames(data_colnames)`
         
         if(!has_numeric)
-            missing_numeric <- c(missing_numeric, valid_colnames[i,1])
+          missing_numeric <- c(missing_numeric, colname)
         
         
         if (data_table[[1]] == "All studies failed for reasons identified below"){
           
-            cannot_analyse_list <- c(cannot_analyse_list,valid_colnames[i,1])
+          cannot_analyse_list <- c(cannot_analyse_list,colname)
           
-          }else  if(!check_values_categoric(values,valid_colnames[i,1])){
+        }else  if(!check_values_categoric(values,colname)){
           
           print("Wrong categoric value:")
-            print(valid_colnames[i,1])
+          print(colname)
           
-            wrong_categoric <- c(wrong_categoric, valid_colnames[i,1])
+          wrong_categoric <- c(wrong_categoric, colname)
           wrong_categoric_values[[k]] <- values
           k <- k+1
         }
         
-          # if((!is_numeric & !has_numeric) | is_numeric)
       }else{
         
-          if(grepl("numeric", valid_colnames[i,1],fixed=TRUE))
-            new_colname <- strsplit(x=valid_colnames[i,1],split="_")[[1]][1]
+        if(grepl("numeric", colname,fixed=TRUE))
+          new_colname <- strsplit(x=colname,split="_")[[1]][1]
         else
-            new_colname <- valid_colnames[i,1]
+          new_colname <- colname
         
         valid <- check_values_not_categoric(values, new_colname)
         
         if (FALSE %in% valid){
-            invalid_name_list <- c(invalid_name_list,valid_colnames[i,1])
+          invalid_name_list <- c(invalid_name_list,colname)
           invalid_values_list[[j]] <- values
           j <- j+1
         }
         
         
-          #print(valid_colnames[i,1])
+        #print(colname)
         #print(values)
         
       }#else
       # print("This variable has a numeric version")
     }
     
-      
-    }
   }
   
   missing_numeric
@@ -553,15 +533,12 @@ data_colnames <- ds.colnames(x=datastructure_name, datasources= connections)
 
 data_colnames <- as.data.frame(data_colnames)
 
-check_valid_columns <- check_column_names(data_colnames)
-
-valid_colnames <- as.data.frame(valid_data_colnames(data_colnames))
-
+check_valid_columns <- check_column_names(codebook ,data_colnames)
+valid_columns <- as.data.frame(check_valid_columns$colnames)
 
 
-#possible_values("CSXCTR")
 result <- ""
-result<-check_valid_values()
+result<-check_valid_values(valid_columns)
 print(check_valid_columns)
 datashield.logout(connections) 
 cat(result)

valid_variables_script_local.R

@@ -120,8 +120,8 @@ check_valid_values_continuous <- function(colname , codebook_param , column){
     str_res <- "No failing values"
   else{
     failing_values <- failing_values[!is.na(failing_values)]
-    #str_res <- paste( colname , paste(unlist(failing_values) , collapse =" "))
-    str_res <- paste(colname , collapse =" ")
+    str_res <- paste( colname , paste(unlist(failing_values) , collapse =" "))
+    #str_res <- paste(colname , collapse =" ")
     str_res <- paste(str_res ,  "should be in range" , range_as_str, "(continuous)", sep = " ")
   }
     
@@ -140,8 +140,8 @@ check_valid_values_binary <- function(colname , column){
   else{
     range_as_str <- "0-1 (binary)"
     failing_values <- failing_values[!is.na(failing_values)]
-    #str_res <- paste(colname , paste(unlist(failing_values) , collapse =" "))
-    str_res <- paste(colname , collapse =" ")
+    str_res <- paste(colname , paste(unlist(failing_values) , collapse =" "))
+    #str_res <- paste(colname , collapse =" ")
     str_res <- paste(str_res ,  "should be in range" , range_as_str, sep = " ")
   }