nhanesR: Tools for "NHANES" Database

Documented in attach_eGFR

#' Caculate eGFR
#'
#' @param data data
#' @param years years
#' @param method 10 methods:
#' - Cockcroft_Gault
#' - MDRD_1999, MDRD_2000, MDRD_2007
#' - CKD_EPI_Scr, CKD_EPI_SCysC, CKD_EPI_Scr_SCysC
#' - Schwartz
#' - BIS1_Scr, BIS2_Scr_SCysC
#'
#' @return eGFR
#' @export
#'
attach_eGFR <- function(data,years,method='CKD_EPI_Scr'){
    allmethod <- c('Cockcroft_Gault',
                   'MDRD_1999','MDRD_2000','MDRD_2007',
                   'CKD_EPI_Scr','CKD_EPI_SCysC','CKD_EPI_Scr_SCysC',
                   'Schwartz',
                   'BIS1_Scr','BIS2_Scr_SCysC')

    left <- set::not(method,allmethod)
    if (length(left)>0){
        if (do::cnOS()) stop(paste0(tmcn::toUTF8("\u4EE5\u4E0B\u65B9\u6CD5\u4E0D\u6B63\u786E: "),paste0(left,collapse = ', ')))
        if (!do::cnOS()) stop(paste0('The following method is not right: ',paste0(left,collapse = ', ')))
    }
# * data ------------------------------------------------------------
    years <- data_years(data,years)

    (demo <- nhs_tsv('demo',items = 'demo',years=years,cat=FALSE))
    (bm <- nhs_tsv('bmx',items = 'exam',years=years,cat=FALSE))
    (biopro <- nhs_tsv('lab18\\.|l40_b\\.|l40_c\\.|biopro',items = 'lab',years=years,cat=FALSE))
    (cyst <- nhs_tsv('sscyst_',items = 'lab',years=years,cat=FALSE))

    data0 <- nhs_read(

        demo,"ridageyr:age","riagendr:sex",
        'ridreth1:eth1','ridreth2:eth2','ridreth3:eth3',

        bm,'bmxwt:weight','bmxht:height',

        biopro,'lbxscr,lbdscr:scr', 'lbxsal:alb','lbxsbu:bun',

        cyst,'sscypc:SCysC',

        lower_cd = TRUE,cat = FALSE)
    if ('1999-2000' %in% data0$Year) data0$scr[data0$Year %in% '1999-2000'] <- 1.013*data0$scr[data0$Year %in% '1999-2000']+0.147
    if ('2005-2006' %in% data0$Year) data0$scr[data0$Year %in% '2005-2006'] <- 0.978*data0$scr[data0$Year %in% '2005-2006']-0.016

    if ('eth1' %in% colnames(data0)){
        data0$eth1 <- recode(data0$eth1,
                             "non-hispanic black::1",
                             "non-hispanic white::0",
                             "other race - including multi-racial::0",
                             "mexican american::0",
                             "other hispanic::0") |> as.numeric()
    }else{
        data0$eth1 <- NA
    }

    if ('eth2' %in% colnames(data0)){
        data0$eth2 <- recode(data0$eth2,
                             "non-hispanic black::1",
                             "non-hispanic white::0",
                             "other race - including multi-racial::0",
                             "mexican american::0",
                             "other hispanic::0") |> as.numeric()
    }else{
        data0$eth2 <- NA
    }
    if ('eth3' %in% colnames(data0)){
        data0$eth3 <- recode(data0$eth3,
                             "non-hispanic white::0",
                             "mexican american::0",
                             "non-hispanic asian::0",
                             "non-hispanic black::1",
                             "other race - including multi-racial::0",
                             "other hispanic::0") |> as.numeric()
    }else{
        data0$eth3 <- NA
    }


    data0$black <- ifelse(rowSums(data0[,c("eth1","eth2","eth3")],na.rm = TRUE) >0,'black','no')
    # data0$black[rowSums(is.na(data0[,c("eth1","eth2","eth3")]))==3] <- NA
# * Cockcroft-Gault 1976 CCr ------------------------------------------------------------
    # (0.85 Female)× (140-Age[year])× weight[kg]/(72×Scr[mg/dL])
    # Cockcroft D . Prediction of creatinine clearance from serum creatinine[J]. Nephron, 1976, 16.
    if ('Cockcroft_Gault' %in% method){
        data0$CG_CCr <- (140-data0$age)*data0$weight/(72*data0$scr)*ifelse(data0$sex=='female',0.85,1)
    }

# * MDRD 1999 ------------------------------------------------------------
    #              170 × Scr[mg/dL]^-0.999 × Age[year]^-0.176 × BUN[mg/dL]^-0.170 × Alb[g/dL]^0.138 × (0.762 Female) × (1.180 Black)
    # Levey AS, Bosch JP, Lewis JB, Greene T, Rogers N, Roth D. A more accurate method to estimate glomerular filtration rate from serum creatinine: a new prediction equation. Modification of Diet in Renal Disease Study Group. Ann Intern Med. 1999 Mar 16;130(6):461-70. doi: 10.7326/0003-4819-130-6-199903160-00002. PMID: 10075613.
    if ('MDRD_1999' %in% method){
        data0$MDRD_1999 <- 170 * (data0$scr^-0.999)    * (data0$age^-0.176)   *(data0$bun^-0.170)*     (data0$alb^0.138)*ifelse(data0$sex=='female',0.762,1)**ifelse(data0$black=='black',1.81,1)
    }

# * MDRD 2000 ------------------------------------------------------------
    # 186 * (Scr^-1.154) * (age^-0.203) * (0.742 Female) * (1.210 Black)
    # Levey A S ,  Greene T ,  Kusek J W , et al. A simplified equation to predict glomerular filtration rate from serum creatinine.[J]. Journal of the American Society of Nephrology, 2000, 11(supplement 15).
    if ('MDRD_2000' %in% method){
        data0$MDRD_2000 <- 186 * (data0$scr^-1.154)    * (data0$age^-0.203)  *ifelse(data0$sex=='female',0.742,1)**ifelse(data0$black=='black',1.210,1)
    }

# * MDRD 2007 ------------------------------------------------------------
    # 175 × Scr[mg/dL]^-1.154 × Age[year]^-0.203 × (0.742 Female)× (1.210 Black)
    # Levey A S ,  Josef C ,  Tom G , et al. Expressing the Modification of Diet in Renal Disease Study Equation for Estimating Glomerular Filtration Rate with Standardized Serum Creatinine Values[J]. Clinical Chemistry, 2007(4):766-772.
    if ('MDRD_2007' %in% method){
        data0$MDRD_2007 <- 175*(data0$scr^-1.154)*(data0$age^-0.203)*ifelse(data0$sex=='female',0.742,1)*ifelse(data0$black=='black',1.210,1)
    }

# * CKD_EPI_Scr ------------------------------------------------------------
    # a × ((Scr/b)^c) × (0.993^age)
    # Levey AS, Stevens LA, Schmid CH, Zhang YL, Castro AF 3rd, Feldman HI, Kusek JW, Eggers P, Van Lente F, Greene T, Coresh J; CKD-EPI (Chronic Kidney Disease Epidemiology Collaboration). A new equation to estimate glomerular filtration rate. Ann Intern Med. 2009 May 5;150(9):604-12. doi: 10.7326/0003-4819-150-9-200905050-00006. Erratum in: Ann Intern Med. 2011 Sep 20;155(6):408. PMID: 19414839; PMCID: PMC2763564.
    if ('CKD_EPI_Scr' %in% method){
        a <- rep(NA,length(data0$black))
        a[data0$black=='black' & data0$sex=='female'] <- 166
        a[data0$black=='black' & data0$sex=='male'] <- 163
        a[data0$black!='black' & data0$sex=='female'] <- 144
        a[data0$black!='black' & data0$sex=='male'] <- 141
        b <- ifelse(data0$sex=='female',0.7,0.9)
        c <- rep(NA,length(data0$black))
        c[data0$sex=='female' & data0$scr<=0.7] <- -0.329
        c[data0$sex=='female' & data0$scr>0.7] <- -1.209
        c[data0$sex=='male' & data0$scr<=0.9] <- -0.411
        c[data0$sex=='male' & data0$scr>0.9] <- -1.209

        data0$CKD_EPI_Scr <- a * ((data0$scr/b)^c) * (0.993^data0$age)
    }
# * CKD_EPI_SCysC ------------------------------------------------------------
    # 133 * ((SCysC/0.8)^a) * (0.996^age) * (0.932 Female)
    # Inker L A ,  Schmid C H ,  Tighiouart H , et al. Estimating glomerular filtration rate from serum creatinine and cystatin C.  2012.
    if ('CKD_EPI_SCysC' %in% method){
        if ('SCysC' %in% colnames(data0)){
            a <- ifelse(data0$SCysC<=0.8,-0.499,-1.328)
            female <- ifelse(data0$sex=='female',0.932,1)
            data0$CKD_EPI_SCysC <- 133 * ((data0$SCysC/0.8)^a) * (0.996^data0$age) * female
        }else{
            if (do::cnOS()) message(tmcn::toUTF8("\u5F53\u524D\u6570\u636E\u6CA1\u6709\u80F1\u6291\u7D20C"))
            if (!do::cnOS()) message('There is no cystatin C in the current data')
        }
    }


# * CKD_EPI_Scr_SCysC ------------------------------------------------------------
    # a * (Scr/b)^c * (SCysC/0.8)^d * (0.995^age) * (1.08 black)
    # the same above
    if ('CKD_EPI_Scr_SCysC' %in% method){
        if ('SCysC' %in% colnames(data0)){
            a <- ifelse(data0$sex=='female',130,135)
            b <- ifelse(data0$sex=='female',0.7,0.9)
            c <- rep(NA,length(data0$sex))
            c[data0$sex=='female' & data0$scr<=0.7] <- -0.248
            c[data0$sex=='female' & data0$scr>0.7] <- -0.601
            c[data0$sex=='male' & data0$scr<=0.9] <- -0.207
            c[data0$sex=='male' & data0$scr>0.9] <- -0.601
            d <- ifelse(data0$SCysC<=0.8,-0.375,-0.711)
            black <- ifelse(data0$black=='black',1.08,1)
            data0$CKD_EPI_Scr_SCysC <- a * ((data0$scr/b)^c) * ((data0$SCysC/0.8)^d) * (0.995^data0$age) *  black
        }else{
            if (do::cnOS()) message(tmcn::toUTF8("\u5F53\u524D\u6570\u636E\u6CA1\u6709\u80F1\u6291\u7D20C"))
            if (!do::cnOS()) message('There is no cystatin C in the current data')
        }
    }


# * Schwartz 2012 ------------------------------------------------------------
    # Schwartz G J ,  Schneider M F ,  Maier P S , et al. Improved equations estimating GFR in children with chronic kidney disease using an immunonephelometric determination of cystatin C.[J]. Kidney International, 2012, 82(4):445-453.
    if ('Schwartz' %in% method){
        if ('SCysC' %in% colnames(data0)){
            data0$Schwartz_2012 <- 39.8 * ((data0$height/100/data0$scr)^0.456) * ((1.8/data0$SCysC)^0.418) * ((30/data0$bun)^0.079) * ifelse(data0$sex=='male',1.076,1) * ((data0$height/100/1.4)^0.179)
        }else{
            if (do::cnOS()) message(tmcn::toUTF8("\u5F53\u524D\u6570\u636E\u6CA1\u6709\u80F1\u6291\u7D20C"))
            if (!do::cnOS()) message('There is no cystatin C in the current data')
        }
    }
# * BIS1_Scr ------------------------------------------------------------
    # Schaeffner E S ,  Ebert N ,  Delanaye P , et al. Two Novel Equations to Estimate Kidney Function in Persons Aged 70 Years or Older[J]. Annals of Internal Medicine, 2012, 157(7):471-81.
    if ('BIS1_Scr' %in% method){
        data0$BIS1_Scr <- 3736*(data0$scr^-0.87)*(data0$age^-0.95)*ifelse(data0$sex=='female',0.82,1)
    }
# * BIS2_Scr_SCysC ------------------------------------------------------------
    if ('BIS2_Scr_SCysC' %in% method){
        if ('SCysC' %in% colnames(data0)){
            data0$BIS2_Scr_SCysC <- 767 * (data0$SCysC^-0.61) * (data0$scr^-0.4) * (data0$age^-0.57) * ifelse(data0$sex=='female',0.87,1)
        }else{
            if (do::cnOS()) message(tmcn::toUTF8("\u5F53\u524D\u6570\u636E\u6CA1\u6709\u80F1\u6291\u7D20C"))
            if (!do::cnOS()) message('There is no cystatin C in the current data')
        }
    }


# * output ------------------------------------------------------------
    if (missing(data)){
        data <- data0[,!colnames(data0) %in% c( "age", "sex", "eth1", "eth2", "weight", "height",
                                      "scr", "alb", "bun", "SCysC", "eth3", "black")]
    }else{
        data0 <- data0[,!colnames(data0) %in% c("age",'Year', "sex", "eth1", "eth2", "weight", "height",
                                               "scr", "alb", "bun", "SCysC", "eth3", "black")]
        data <- as.data.frame(dplyr::left_join(data,data0,'seqn'))
    }

    return(data)
}