R/hei_fped0304.R

In yikeshu0611/nhanesR: Tools for "NHANES" Database

fped0304 <- function(day=1,dietary='iff'){
    fpeddir <- paste0(get_config_path(),'/fped')
    f <- list.files(fpeddir,'equiv0304.sas7bdat',recursive = TRUE,full.names = TRUE)
    mped <- as.data.frame(haven::read_sas(f))
    colnames(mped) <- tolower(colnames(mped))
    mped <- drop_col(mped,'equivflag')
    colnames(mped)[1] <- 'fdcd'
    colnames(mped)[2] <- 'mc'

    mped$m_soy[mped$fdcd==11310000] <- 0
    mped$d_total[mped$fdcd==11310000] <- round(100*(1/244),3)

    mped$m_soy[mped$fdcd==11320000] <- 0
    mped$d_total[mped$fdcd==11320000] <- round(100*(1/245),3)

    mped$m_soy[mped$fdcd==11321000] <- 0
    mped$d_total[mped$fdcd==11321000] <- round(100*(1/240),3)

    mped$m_soy[mped$fdcd==11330000] <- 0
    mped$d_total[mped$fdcd==11330000] <- round(100*(1/245),3)

    ck <- mped$fdcd == 58106210
    mped$g_total[ck] <- 1.88
    mped$g_whl[ck] <- 0
    mped$g_nwhl[ck] <- 1.88
    mped$v_total[ck] <- 0.12
    mped$v_tomato[ck] <- 0.12
    mped$d_total[ck] <- 0.70
    mped$d_cheese[ck] <- 0.70
    mped$discfat_oil[ck] <- 0.44
    mped$discfat_sol[ck] <- 8.00
    mped$add_sug[ck] <- 0.19

    ck <- mped$fdcd == 58106220
    mped$g_total[ck] <- 1.75
    mped$g_whl[ck] <- 0
    mped$g_nwhl[ck] <- 1.75
    mped$v_total[ck] <- 0.12
    mped$v_tomato[ck] <- 0.12
    mped$d_total[ck] <- 0.66
    mped$d_cheese[ck] <- 0.66
    mped$discfat_oil[ck] <- 0.44
    mped$discfat_sol[ck] <- 10.62
    mped$add_sug[ck] <- 0.19

    ck <- mped$fdcd == 58106230
    mped$g_total[ck] <- 1.88
    mped$g_whl[ck] <- 0
    mped$g_nwhl[ck] <- 1.88
    mped$v_total[ck] <- 0.12
    mped$v_tomato[ck] <- 0.12
    mped$d_total[ck] <- 0.66
    mped$d_cheese[ck] <- 0.66
    mped$discfat_oil[ck] <- 0.44
    mped$discfat_sol[ck] <- 8.82
    mped$add_sug[ck] <- 0.19
    f <- list.files(fpeddir,'cnppmyp_v1nhanes0304_wjfrt.sas7bdat',recursive = TRUE,full.names = TRUE)
    jfrt <- as.data.frame(haven::read_sas(f))
    colnames(jfrt) <- tolower(colnames(jfrt))
    jfrt <- jfrt[,c("foodcode","modcode","frtjuice","wholefrt")]
    colnames(jfrt)[1] <- 'fdcd'
    colnames(jfrt)[2] <- 'mc'

    newmped <- dplyr::inner_join(mped,jfrt,c('fdcd','mc'))

    food <- nhs_read(nhs_tsv(sprintf('%siff_c',day),cat = FALSE),
                     'dr1igrms,dr2igrms:grms',
                     'dr1drstz,dr2drstz:rstz',
                     cat = FALSE,codebook = FALSE,Year = FALSE)
    demo <- nhs_read(nhs_tsv('demo_c',cat = FALSE),'ridageyr',
                     cat = FALSE,codebook = FALSE,Year = FALSE)
    food <- dplyr::inner_join(food,demo,'seqn')
    colnames(food)[colnames(food) %in% c('dr1ifdcd','dr2ifdcd')] <- 'fdcd'
    colnames(food)[colnames(food) %in% c('dr1mc','dr2mc')] <- 'mc'
    colnames(food)[colnames(food) %in% c('dr1iline','dr2iline')] <- 'line'

    fdpyr <- dplyr::inner_join(food,newmped,c('fdcd','mc'))

    pyrvar <- colnames(newmped)[-c(1,2)]
    for (i in pyrvar) {
        fdpyr[,i] <- fdpyr[,i] * fdpyr$grms / 100
    }
    fdpyr <- fdpyr[,c('seqn','line','ridageyr','rstz',pyrvar)]
    fdpyr[,pyrvar][fdpyr[,pyrvar]<0] <- 0
    if (dietary=='tot'){
        fped <- NULL
        for (i in pyrvar) {
            di <- aggregate(fdpyr[,i], list(seqn=fdpyr$seqn), FUN=sum)
            colnames(di)[2] <- i
            if (is.null(fped)){
                fped <- di
            }else{
                fped <- dplyr::inner_join(fped,di,'seqn')
            }
        }
        fped[,pyrvar][fped[,pyrvar]<0] <- 0
        fped <- dplyr::inner_join(fped,unique(fdpyr[,c("seqn", "ridageyr", "rstz")]),'seqn')
    }else{
        fped <- fdpyr
    }
    colnames(fped)[colnames(fped) == 'wholefrt'] <- 'f_whole'
    colnames(fped)[colnames(fped) == 'frtjuice'] <- 'f_juice'
    colnames(fped)[colnames(fped) == 'v_orange'] <- 'v_dpyel'
    return(fped)
}