R/build_varLabel_codebook.R

In yikeshu0611/nhanesR: Tools for "NHANES" Database

#' Build variable label file
#'
#' @param progress logical, whether to show progress
#'
#' @return
#' @export
#'
build_varLabel <- function(progress=FALSE){
    varLabel <- nhs_files_pc(file_ext = 'varLabel')
    if (length(varLabel)==0) return()
    if (progress) pb <- txtProgressBar(max = length(varLabel),width = 30,style = 3)
    fd <- lapply(varLabel, function(i){
        if (progress) setTxtProgressBar(pb,which(varLabel==i))
        (df <- read.delim(i,comment.char = '#'))
        if (nrow(df)==0) return()
        # Year_Item <- paste0(prepare_years(i),'\n',prepare_items(i))
        file <- do::file.name(i) |> do::Replace0('\\.varLabel')
        cbind(year = prepare_years(i),
              item=prepare_items(i),
              file=file,
              df)
    }) |>
        do.call(what = plyr::rbind.fill)
    data.table::fwrite(fd,
                       paste0(get_config_path(),'/varLabel.txt'),
                       sep = '\t',row.names = FALSE)
    if (progress) cat('\n')
}
#' Build codebook file
#'
#' @param progress logical, whether to show progress
#'
#' @return
#' @export
build_codebook <- function(progress=FALSE){
    files <- nhs_tsv()
    ck <- tools::file_ext(files) != 'codebook'
    if (any(ck)){
        ext <- tools::file_ext(files[ck]) |> unique() |> sprintf(fmt = '\\.%s')
        files[ck] <- do::Replace0(files[ck],ext) |> sprintf(fmt = '%s.codebook')
    }
    if (progress) pb <- txtProgressBar(max = length(files),width = 30,style = 3)
    fd <- lapply(files, function(i){
        if (progress) setTxtProgressBar(pb,which(files==i))
        i <- do::formal_dir(i) |> do::Replace('//','/')
        (Year <- prepare_years(i))
        (Item <- prepare_items(i))
        (file <- do::file.name(i) |> do::Replace0('\\.codebook'))
        (codei <- read.delim(i,comment.char = '#'))
        if (nrow(codei)==0) return()
        (codei <- codei[,c('variable','code','label')])
        cbind(Year=Year,Item=Item,file=file,codei)
    }) |> do.call(what = plyr::rbind.fill)
    data.table::fwrite(fd,
                       paste0(get_config_path(),'/codebook.txt'),
                       sep = '\t',row.names = FALSE)
    if (progress) cat('\n')
}