R/readmacro.R

In adayim/cctab: Tables of Descriptive Statistics in word

#'
#' Read MACRO data with metadata attributes
#'
#' @description Read macro data and corresponding CLU and DLU data. Apply DLU and
#' CLU data as variable label and value labels.
#'
#' @param path Path of the data.
#' @param file_name Filename of the dataset. This filename will also be used to
#' DLU and CLU file if `read_meta` is set to `TRUE`.
#' @param read_meta If set to `TRUE` (default), DLU and CLU file will be used to
#' create variable label and value labels.
#' @param date_format The format of the date in the dataset to convert it to date,
#' the default format is `\%d/\%m/\%Y`.
#'
#' @return A data.frame with variable and value label attributes.
#'
#' @examples
#' \dontrun{
#' dt <- read_macro(path = "data_raw", file_name = "test_data_csv.csv")
#' }
#'
#' @export
#' 

read_macro <- function(path,
                       file_name,
                       read_meta = TRUE,
                       date_format = "%d/%m/%Y") {
  if (!dir.exists(path))
    stop("Path '",
         path,
         "' does not exist, please check if this the right path!")
  
  # Remove .csv extension
  file_name <- tools::file_path_sans_ext(file_name)
  
  data <-
    utils::read.csv(file.path(path, paste0(file_name, ".csv")))
  
  if (read_meta) {
    # DLU & CLU
    dlu <-
      utils::read.csv(file.path(path, paste0(file_name, "_DLU.csv")))
    clu <-
      utils::read.csv(file.path(path, paste0(file_name, "_CLU.csv")))
    
    for (i in dlu$ShortCode) {
      # Assign label
      var_lab(data[[i]]) <- dlu$Description[dlu$ShortCode == i]
      
      # Assign value label
      if (i %in% clu$ShortCode) {
        valab <- clu[clu$ShortCode == i, "CatCode"]
        names(valab) <- clu[clu$ShortCode == i, "CatValue"]
        val_lab(data[[i]]) <- valab
      }
      
      # Format date
      if (dlu$Type[dlu$ShortCode == i] == "Date")
        data[[i]] <- as.Date(data[[i]], date_format)
    }
    
  }
  return(data)
}



#' Tidy DLU form
#' 

#' @description Separate Visit, Form and Question into different columns
#'
#' @param x DLU data.frame
#' 
#' @export
#'
sep_dlu <- function(x){
  vfq <- strsplit(as.character(x$Visit.Form.Question),'/') 
  vfq <- as.data.frame(do.call(rbind, vfq))
  colnames(vfq) <- c("Visit", "Form", "Question")
  cbind.data.frame(x[, -2], vfq)
}

#' Extract data by form from MACRO dataset
#' 
#' @description Extract data by form from MACRO dataset. Data will be transformed to long format
#'  adding a new column of `Visit`.
#'
#' @param data A data.frame from macro dataset.
#' @param form Name of the form.
#' @param dlu A DLU data.frame
#'
#' @export
#'
#' @examples
#' \dontrun{
#' extract_form(full_dt, "LabResF", dlu)
#' }
#' 
#' @importFrom stats setNames
#' 
#' 
extract_form <- function(data, form, dlu){
  if(ncol(dlu) == 4 & names(dlu)[2] == "Visit.Form.Question")
    dlu <- sep_dlu(dlu)
  
  dlu <- dlu[dlu$Form == form, ]
  res <- lapply(dlu$Visit, function(v){
    dt <- data[, dlu$ShortCode[dlu$Visit == v]]
    colnames(dt) <- dlu$Question[dlu$Visit == v]
    dt$FormVisit <- v
    # dt[!is.na(dt$SUBJIDd), ]
    dt
  })
  res <- as.data.frame(do.call(rbind, res))
  
  # Assign label
  var_labs <- unique(dlu[, c("Question", "Description")])
  var_lab(res) <- setNames(c(var_labs$Description, "Visit"),
                             c(var_labs$Question, "FormVisit"))
  
  
  return(res)
}