cosmosR/R/charger.R

#' Charger un fichier de donnees dans l'environnement
#' 
#' Charge un fichier texte ou excel contenant les donnees ainsi que les formats et labels
#' 
#' La fonction charge les donnees contenues dans le fichier de donnees et renvoie une table de valeurs.
#' Si des labels/formats sont definis ils seront appliques (fichiers labels.sas, formats.sas et attribformats.sas)
#' Les variables pour lesquelles un format est defini seront considerees comme des variables qualitatives.
#' La table de valeurs prend automatiquement le nom du fichier (suffixe par le numero de feuille).
#' Le fichier de donnees est charge depuis ../../data/, les formats depuis le repertoire courant.
#' @encoding UTF-8
#' @param fichier Fichier de donnees a charger
#' @param feuille Feuille a utiliser si fichier excel et en cas de feuilles mutiples (et qu'on veut acceder a une feuille au-dela de la premiere)
#' @param chemin Chemin ou trouver le fichier de donnees (par defaut ../../data/)
#' @return La data frame avec les labels et formats
#' @examples
#' \dontrun{Ma_table <- charger("donnees.xls", feuille=2)}
#' @export
charger <- function(fichier,feuille=1,chemin="../../data/")
{
  # Verification de la presence du fichier
  fichier<-paste(chemin,fichier,sep="")
  if (!file.exists(fichier))
  {
    warning("Le fichier source n'existe pas !")
    return -1
  }
  
  # Lecture du fichier selon l'extension
  if (grepl("\\.csv$",fichier) || grepl("\\.txt$",fichier))
    x<-read.csv2(fichier, na.strings="",encoding="native.enc")
  else if (grepl("\\.xlsx?$",fichier))
    x<-read.xlsx(fichier,feuille,encoding="native.enc")
  
  # Lecture des formats a partir du fichier SAS
  x <- loadFormatsFromFile(x, "formats.sas", "attribformats.sas")
  
  # Lecture des labels a partir du fichier SAS
  x <- loadLabelsFromFile(x,"labels.sas")

  return(x)
}


#' Load labels from a flat file
#' 
#' Loads label values from a flat file and applies them to the provided dataframe
#' 
#' This function takes a dataframe and adds label attributes to the variables.
#' The file must be formatted like so :
#' variablename = "Label for the variable"
#' with one line per variable
#' As always, be careful of the case sensitiveness and the use of double quotes !
#' @encoding UTF-8
#' @param dataframe The dataframe to which you want to assign labels
#' @param file The flat file from which to load the label data
#' @return The dataframe with label attributes
#' @examples
#' \dontrun{df <- loadLabelsFromFile(df,"labels.txt")}
#' @export
loadLabelsFromFile <- function(dataframe, file)
{
  if (missing(dataframe) | missing(file))
  {
    warning("Dataframe or file missing")
    return -1
  }
  
  if (!file.exists(file))
  {
    warning("File doesn't exists")
    return -1
  }
  
  con=file(file,"r",encoding="native.enc")
  labelsfile=readLines(con)
  close(con)
  labels=labelsfile[grepl('^ *\\w*?[[:space:]]*=[[:space:]]*\\".*?\\" *$',labelsfile)]
  labels=paste(labels,collapse=",")
  label_exe = paste("label(dataframe)<-c(",labels,")")
  eval(parse(text=label_exe))

  dataframe
}

#' Load formats from flat files
#' 
#' Loads factor levels from flat files and applies them to the provided dataframe
#' 
#' This function takes a dataframe and assigns factor levels to the corresponding variables.
#' Two files must be provided :
#' One describing the formats to be used (permitting the re-use of a defined format), which must be formatted like so:
#' value format_name
#'    value0_in_data_frame = 'Label for level 0'
#'    value1_in_data_frame = "Label for level 1"
#' and so on.
#' As shown, both single and double quotes are accepted.
#' The value before the equal sign can be numeric (categorical coding) or text for recoding.
#' The other file assigns defined formats to variables in the dataframe. It must be formatted like so:
#' var1 var2 var3 varN format=format_name
#' with one line for every assigned format.
#' As always, be careful of the case sensitiveness.
#' @encoding UTF-8
#' @param dataframe The dataframe to which you want to assign labels
#' @param file The flat file from which to load the label data
#' @return The dataframe with label attributes
#' @examples
#' \dontrun{df <- loadFormatsFromFile(df,"formats.txt","attribformats.txt")}
#' @export
loadFormatsFromFile <- function(dataframe, file_format, file_attrib)
{
  if (missing(dataframe) | missing(file_format) | missing(file_attrib))
  {
    warning("Dataframe or file missing")
    return -1
  }
  
  if (!file.exists(file_format) | !file.exists(file_attrib))
  {
    warning("One of the files doesn't exist !")
    return -1
  }
  
  formats=list(0)
  
  con=file(file_format,"r",encoding="native.enc")
  formatsfile=readLines(con)
  close(con)
  
  # Nettoyage du fichier : espaces de debut et fin, et autour des '=', commentaires, conservation uniquement des lignes significatives (value xxx et 'code'='level')
  formatsfile=sub("^[[:space:]]*(.*?)[[:space:]]*$","\\1",formatsfile)
  formatsfile=sub("[[:space:]]*=[[:space:]]*","=",formatsfile)
  formatsfile=sub("/\\*.*?\\*/","",formatsfile)
  formatsfile=sub(";","",formatsfile)
  formatsfile=formatsfile[grepl("^value[[:space:]]*\\w",formatsfile) | grepl(".*?=(\\'|\").*?(\\'|\")",formatsfile)]
  formatsfile=sub("^(.*?)=","\\'\\1\\'=",formatsfile)
  
  # Creation de la liste de formats
  for (format in formatsfile)
  {
    if (grepl("^value *\\w",format))
      formats[[strsplit(format," ")[[1]][2]]]<-character(0)
    else
      eval(parse(text=paste0("formats[[length(formats)]]<-c(formats[[length(formats)]],",format,")")))
  }
  formats[[1]]<-NULL
  
  
  con=file(file_attrib,"r",encoding="native.enc")
  attribfile=readLines(con)
  close(con)
  
  # Nettoyage du fichier : espaces de debut et fin, espaces multiples, autour des '=', '.' final, conservation uniquement des lignes significatives (finissant en format=xxx)
  attribfile=sub("^[[:space:]]*(.*?)[[:space:]]*$","\\1",attribfile)
  attribfile=sub("\\.?$","",attribfile)
  attribfile=sub("/\\*.*?\\*/","",attribfile)
  attribfile=sub(";","",attribfile)
  attribfile=sub("[[:space:]]*=[[:space:]]*","=",attribfile)
  attribfile=attribfile[grepl("(\\w[[:space:]]+)+format=\\w",attribfile)]
  attribfile=gsub("[[:space:]]+"," ",attribfile)
  
  # Attribution des formats aux variables concernees
  for (attrib in attribfile)
  {
    attrib=strsplit(attrib," ")[[1]]
    format=strsplit(attrib[length(attrib)],"=")[[1]][2]
    for (var in attrib[-length(attrib)])
    {
      if (!is.null(dataframe[[var]]))
        dataframe[[var]]<-factor(dataframe[[var]],levels=names(formats[[format]]),labels=formats[[format]])
    }
  }
  
  # Remplacement des "" par NA dans les facteurs
  for (var in names(dataframe))
  {
    if (is.factor(dataframe[[var]]))
      levels(dataframe[[var]])[levels(dataframe[[var]])==""]<-NA
  }
  
  dataframe
}