dumbcode/producerdm.R

In jomuller/vartors: Transform Definition of Variables to R Scripts

# Produce R script for datamagemet

vardef <- read.table(header = TRUE, text = "
varname label comment type unit
age Age NA numeric NA
sex Sexe NA factor NA
")

moddef <- read.table(header = TRUE, text = "
varname level name
sex 0 woman
sex 1 man
")

vardef <- list("varname"="sex","label"="Gender","comment"="Gender of patient if any","type"="factor","levels"=c("0","1"),"names"=c("man","woman"))


a <- import_template()
a
bloc_numeric <- get_bloc_type(a,"numeric")

# For one variable
replacement_dict <- c('rep_cleandata'= 'clean_data',
'rep_rawdata'= 'raw_data',
"rep_variable"= "varname",
"rep_label"= "label",
"rep_levels"= "levels",
"rep_names"= "names" )

new_bloc <- bloc_numeric
for(i in seq_along(replacement_dict)){
  key <- names(replacement_dict[i])
  replacement <- replacement_dict[i]
  new_bloc <- gsub( pattern=key, replacement=replacement, x=new_bloc )
}
new_bloc

format_charvector <- function(char_vector)
  paste0("c('",paste0(char_vector, collapse="', '"),"')")

format_names <- function(var_names=character()){
  if(length(var_names)==0){
    return("levels")
  } else {
    return(format_charvector(var_names))
  }
}

format_levels <-function(var_levels=character(),rawdata,varname){
  if(length(var_levels)==0)
    return(paste0("unique(",rawdata,"$",varname,")"))
  else
    return(format_charvector(var_levels))
}

replace_template <- function(vardef, dm_template=import_template(), rawdata_name = "raw_data", cleandata_name="clean_data"){
  replacement_dict <- c('rep_cleandata'= cleandata_name,
                        'rep_rawdata'= rawdata_name,
                        "rep_variable"= vardef$varname,
                        "rep_label"= vardef$label,
                        "rep_levels"= format_charvector(vardef$levels),
                        "rep_names"=  format_names(vardef$names)
  )
  
  # Get the good template
  bloc <- get_bloc_type(dm_template, vardef$type)
  
  # Replace
  new_bloc <- bloc
  for(i in seq_along(replacement_dict)){
    key <- names(replacement_dict[i])
    replacement <- replacement_dict[i]
    new_bloc <- gsub( pattern=key, replacement=replacement, x=new_bloc )
  }
  
  return(new_bloc)
}

a<-replace_template(vardef=vardef, dm_template=import_template())
cat(a,sep="\n")

varsdef <- list( 
  "sex"=list("varname"="sex","label"="Gender","comment"="Gender of patient if any","type"="factor","levels"=c("0","1"),"names"=c("man","woman")),
  "age"=list("varname"="age","label"="Age","comment"="Age of patient if any","type"="factor"))
# Puis boucler
lapply(X=varsdef, replace_template, import_template())

# Donc besoin d'un objet vardef qui defini chaque variable
# Et un objet varsdef qui defini les variables
# un objet dbdef qui contient les autres infos propres a la bdd

replace_template2 <- function(vardef, dm_template=import_template(), rawdata_name = "raw_data", cleandata_name="clean_data"){
  
  if(vardef@type=="ordered"){
  ordered_factor <- "TRUE"
  } else {
    ordered_factor <- "FALSE"
  }
  replacement_dict <- c('rep_cleandata'= cleandata_name,
                        'rep_rawdata'= rawdata_name,
                        "rep_variable"= vardef@varname,
                        "rep_label"= vardef@label,
                        "rep_levels"= format_levels(vardef@levels,rawdata_name,vardef@varname),
                        "rep_names"=  format_names(vardef@names),
                        "rep_orderedfactor"=ordered_factor
  )
  
  # Get the good template
  bloc <- get_bloc_type(dm_template, vardef@type)
  
  # Replace
  new_bloc <- bloc
  for(i in seq_along(replacement_dict)){
    key <- names(replacement_dict[i])
    replacement <- replacement_dict[i]
    new_bloc <- gsub( pattern=key, replacement=replacement, x=new_bloc )
  }
  
  return(new_bloc)
}

replace_template2(Descvar("test"))
replace_template2(Descvar("test", type="factor"))
replace_template2(Descvar("test", type="factor", levels=c(1,2,3), names=c("ds","dsd","qmlksjd")))