R/nhs_update.R

In yikeshu0611/nhanesR: Tools for "NHANES" Database

#' update "NHANES" database
#'
#' @param years one or more years
#' @param items one or more items
#'
#' @importFrom do  %+%
#' @return update local "NHANES" database
#' @export
#'
#' @examples
#' \donttest{
#' nhs_update()
#' }
nhs_update <- function(years,items){
    (mode <- test_mode())
    (years <- prepare_years(years))
    (items <- prepare_items(items))
    for (i in 1:length(years)) {
        (yeari <- years[i])
        cat('\n',yeari)
        for (j in 1:length(items)) {
            (itemsi <- items[j])
            cat('\n     ',itemsi)
            (pathj <- paste0(get_config_path(),'/',yeari,'/',itemsi,'/'))
            filetable <- nhs_files_web(years = yeari,items = itemsi,FALSE)
            if (nrow(filetable)==0) next(j)
            if (ncol(filetable)==2) next(j)
            for (k in 1:nrow(filetable)) {
                (filek <- filetable[k,])
                filek[1,1] <- prepare_years(filek[1,1])
                (fns <- filek$`Doc File` |> do::Trim() |> do::Replace0(' .*'))
                (upk <- paste0(fns,'.update'))
                (update <- paste0(pathj,upk))
                (ck <- file.exists(update))
                if (ck){ # already exist: old, withdrawn, new
                    (upread <- read.delim(update,header = TRUE))
                    (upread[1,1] <- prepare_years(upread[1,1]))
                    (ck <- upread$Date.Published == filek$`Date Published`)
                    if (ck) next(k) # old, then next
                    if (filek[,"Date Published"]=='withdrawn'){
                        cat('\n       ',fns,crayon::red('withdrawn'),'KEEP')
                        next(k)
                    }else{# new
                        cat('\n       ',fns,crayon::red('update'),filek[,"Date Published"])
                        # ------- update
                        (sizej <- filek$`Data File` |> do::Replace0(c('.*- {0,}','\\].*')))
                        cat(crayon::blue(paste0('(size: ',sizej)))
                        filepage(yeari = yeari,itemsi = itemsi,mode=mode,filetable=filek,redown = TRUE,cat=FALSE,update = TRUE)
                    }
                }else{# NOT exist: already withdrawn, new
                    if (filek[,"Date Published"]=='withdrawn'){
                        cat('\n       ',fns,crayon::red('Already withdrawn, not download yet'))
                        filepage(yeari = yeari,itemsi = itemsi,filetable=filek,redown = FALSE,cat=FALSE,update = TRUE)
                    }else{
                        cat('\n       ',fns,crayon::red('new'),filek[,"Date Published"])
                        # ------ update
                        (sizej <- filek$`Data File` |> do::Replace0(c('.*- {0,}','\\].*')))
                        cat(crayon::blue(paste0('(size: ',sizej)))
                        filepage(yeari = yeari,itemsi = itemsi,mode=mode,filetable=filek,redown = TRUE,cat=FALSE,update = TRUE)
                    }
                }
            }
            (fns <- do::file.name(filetable$`Data url`) |> tolower())
            (ck <- tools::file_ext(fns) == 'zip')
            if (any(ck)){
                cki <- gsub('\\.zip','.sas7bdat',fns[ck])
                sas7 <- pathj %+% cki
                if (file.exists(sas7)){
                    fns[ck] <- cki
                }else{
                    cki <- gsub('\\.zip','.xpt',fns[ck])
                    xpt <- pathj %+% cki
                    if (file.exists(xpt)){
                        fns[ck] <- cki
                    }
                }
            }
            fns
            fnr <- list.files(pathj,'\\.xpt|\\.sas7bdat')
            fnn <- set::not(fnr,fns)
            (ck <- length(fnn) == 0)
            if (ck >0){
                for (k in fnn) {
                    cat('\n       ',k,crayon::red('withdrawn'))
                }
            }
        }
    }
    build_codebook()
    build_varLabel()
    writeLines(as.character(Sys.Date()),paste0(get_config_path(),'/update.txt'))
    cat('\n')
}