R/attach_HEI.R

In yikeshu0611/nhanesR: Tools for "NHANES" Database

#' Calculate Healthy Eating Index
#'
#' @param data data to be attached
#' @param years years
#' @param version 2015 or 2010
#' @param method ssum or pratio. ssum: simple sum, pratio: population ratio
#' @param dietary tot or iff
#' @param day 1 or 2 for per day, 1 and 2 for per person
#' @param varLabel (for ssum) logical. whether to add variable label to HEI data
#' @param energy (for ssum) logical. whether to keep energy column
#' @param component (for ssum) logical. whether to keep component columns
#' @param density (for ssum) logical. whether to keep density columns
#' @param seed (for pratio) seed
#'
#' @return Healthy Eating Index
#' @export
#'
attach_HEI <- function(data,years,
                       version=c('2015','2010'),
                       method=c('ssum','pratio'),
                       dietary=c('tot','iff'),
                       day=1,
                       varLabel=FALSE,
                       energy=TRUE,
                       component=TRUE,
                       density=FALSE,
                       seed=NULL
                       ){
    version <- as.character(version)
    version <- match.arg(version)
    dietary <- match.arg(dietary)
    method <- match.arg(method)
    if (!all(day %in% c(1,2))){
        if (do::cnOS()) stop(tmcn::toUTF8("day\u5FC5\u987B\u662F1\u6216\u80052"))
        if (!do::cnOS()) stop('day must be 1 or 2')
    }
    if (!missing(data)){
        seqn <- unique(data$seqn)
    }else{
        seqn <- NULL
    }
    years <- data_years(data,years)

    # simple sum
    if (version==2015 &  method=='ssum'){
        if (all(c(1,2) %in% day)){
            hei <- hei_2015_PerPerson_ssum(years=years,dietary=dietary,varLabel=varLabel,energy=energy,component=component,density=density)
        }else{
            hei <- hei_2015_PerDay_ssum(years=years,day=day,dietary=dietary, varLabel=varLabel,energy=energy,component=component,density=density)
        }
    }
    if(version==2010 &  method=='ssum'){
        if (all(c(1,2) %in% day)){
            hei <- hei_2010_PerPerson_ssum(years=years,dietary=dietary,varLabel=varLabel,energy=energy,component=component,density=density)
        }else{
            hei <- hei_2010_PerDay_ssum(years=years,day=day, dietary=dietary,varLabel=varLabel,energy=energy,component=component,density=density)
        }
    }

    # population ratio
    if (version==2015 &  method=='pratio'){
        if (all(c(1,2) %in% day)){
            hei <- hei_2015_PerPerson_pratio(seqn=seqn,years=years,dietary=dietary,seed=seed)
        }else{
            hei <- hei_2015_PerDay_pratio(seqn=seqn,years=years,day=day,dietary=dietary,seed=seed)
        }
        return(hei)
    }
    if (version==2010 &  method=='pratio'){
        if (all(c(1,2) %in% day)){
            hei <- hei_2010_PerPerson_pratio(seqn=seqn,years=years,dietary=dietary,seed=seed)
        }else{
            hei <- hei_2010_PerDay_pratio(seqn=seqn,years=years,day=day,dietary=dietary,seed=seed)
        }
        return(hei)
    }
    if (!missing(data)){
        if (dietary=='iff') join <- c('seqn','line') else join <- 'seqn'
        colnames(data) <- rename_line(colnames(data))
        join <- set::and(join,colnames(data),colnames(hei))
        data <- dplyr::left_join(data,hei,join)
        return(data)
    }
    return(hei)
}