R/attach_demo.R

In yikeshu0611/nhanesR: Tools for "NHANES" Database

#' extract demo data
#'
#' @param data data
#' @param years years
#' @param ageyr logical or variable name
#' @param agemth logical or variable name
#' @param sex logical or variable name
#' @param eth1 logical or variable name
#' @param eth2 logical or variable name
#' @param eth3 logical or variable name
#' @param military logical or variable name
#' @param country_of_birth logical or variable name
#' @param citizenship logical or variable name
#' @param time_in_US logical or variable name
#' @param edu logical or variable name
#' @param in_school logical or variable name
#' @param marital logical or variable name
#' @param household_size logical or variable name
#' @param family_size logical or variable name
#' @param annual_household_income logical or variable name
#' @param annual_family_income logical or variable name
#' @param poverty logical or variable name
#' @param psu  logical or variable name
#' @param strata  logical or variable name
#' @param wtint2yr  logical or variable name
#' @param wtint4yr  logical or variable name
#' @param wtmec2yr  logical or variable name
#' @param wtmec4yr  logical or variable name
#' @param Year logical
#' @param status logical
#' @param exam_month logical
#'
#' @return dataframe
#' @export
#'
attach_demo <- function(data,years,
                        ageyr,
                        agemth,
                        sex,
                        eth1,
                        eth2,
                        eth3,
                        military,
                        country_of_birth ,
                        citizenship,
                        time_in_US,
                        edu,
                        in_school,
                        marital,
                        household_size,
                        family_size,
                        annual_household_income,
                        annual_family_income,
                        poverty,
                        status,
                        exam_month,
                        psu,
                        strata,
                        wtint2yr,
                        wtint4yr,
                        wtmec2yr,
                        wtmec4yr,
                        Year=FALSE
){
    years <- data_years(data,years)
    tsv <- nhs_tsv('demo',years = years,cat=FALSE)
    if (!missing(edu)){
        if (isFALSE(edu)){
            eduname <- 'edu'
        }else if(isTRUE(edu)){
            eduname <- 'edu'
        }else if(edu =='-u' & nchar(edu)==2){
            eduname <- 'edu'
        }else if(edu =='-u' & nchar(edu)>2){
            edu <- '-u'
            eduname <- do::knife_right(edu,2)
        }else if(is.character(edu)){
            edu <- TRUE
            eduname <- edu
        }
    }
    var <- c()
    var <- var |>
        attach_variable_formula(ageyr,'ridageyr') |>
        attach_variable_formula(agemth,'ridagemn') |>
        attach_variable_formula(sex,'riagendr') |>
        attach_variable_formula(eth1,'ridreth1') |>
        attach_variable_formula(eth2,'ridreth2') |>
        attach_variable_formula(eth3,'ridreth3') |>
        attach_variable_formula(edu,'dmdeduc2') |>
        attach_variable_formula(edu,'dmdeduc3') |>
        attach_variable_formula(military,'dmqmilit,dmqmiliz') |>
        attach_variable_formula(country_of_birth,'dmdborn,dmdborn2,dmdborn4') |>
        attach_variable_formula(citizenship,'dmdcitzn') |>
        attach_variable_formula(time_in_US,'dmdyrsus') |>
        attach_variable_formula(in_school,'dmdschol') |>
        attach_variable_formula(marital,'dmdmartl,dmdmartz') |>
        attach_variable_formula(household_size,'dmdhhsiz') |>
        attach_variable_formula(family_size,'dmdfmsiz') |>
        attach_variable_formula(annual_household_income,'indhhinc,indhhin2') |>
        attach_variable_formula(annual_family_income,'indfminc,indfminc2') |>
        attach_variable_formula(poverty,'indfmpir') |>
        attach_variable_formula(status,'ridstatr') |>
        attach_variable_formula(exam_month,'ridexmon') |>
        attach_variable_formula(psu,'sdmvpsu') |>
        attach_variable_formula(strata,'sdmvstra') |>
        attach_variable_formula(wtint2yr,'wtint2yr') |>
        attach_variable_formula(wtint4yr,'wtint4yr') |>
        attach_variable_formula(wtmec2yr,'wtmec2yr') |>
        attach_variable_formula(wtmec4yr,'wtmec4yr')
    var[var %in% c("dmdeduc2:edu", "dmdeduc3:edu")] <- c("dmdeduc2", "dmdeduc3")
    var[var %in% c("dmdeduc2:edu-u", "dmdeduc3:edu-u")] <- c("dmdeduc2-u", "dmdeduc3-u")
    d <- nhs_read(tsv,var,cat = FALSE,Year = Year)
    if (all(c('dmdeduc2','dmdeduc3') %in% colnames(d))){
        d$edu <- ifelse(is.na(d$dmdeduc2),d$dmdeduc3,d$dmdeduc2)
        d <- drop_col(d,'dmdeduc2','dmdeduc3')
        colnames(d)[colnames(d)=='edu'] <- eduname
    }
    attach_return_data(data,d,Year,'seqn')
}