R/attach_PHQ9.R

In yikeshu0611/nhanesR: Tools for "NHANES" Database

#' add depression of "PHQ-9"
#'
#' @param data dataframe or list to be attarched
#' @param years years
#' @param cut one or more numeric cut point
#' @param na0 logical. whether to use missing value as 0 score
#' @param score FALSE(default). logical. whether to add raw "PHQ-9" score and answer
#' @param dpq FALSE(default). logical. whether to add "PHQ-9" questions
#' @param varLabel logical. whether to add label to variable
#'
#' @return attach new column "PHQ9" with levels of None, Mild, Moderate, Moderately-Severe and Severe depression
#' @export
#' @references Kroenke K, Spitzer RL. The PHQ-9: A new depression and diagnostic severity measure. Psychiatric Annals 2002; 32:509-521.
attach_PHQ9 <- function(data,years,cut,
                        na0=FALSE,
                        score=FALSE,
                        dpq=FALSE,
                        varLabel=FALSE){
    if (!missing(data)){
        years <- unique(data$Year)
    }
    years <- prepare_years(years)
    tsv <- nhs_tsv('dpq',items = 'q',years = prepare_years(years),cat=FALSE)
    if (length(tsv)==0){
        if (do::cnOS()) stop(paste0(paste0(years,collapse = ','),tmcn::toUTF8(" \u5E74\u6CA1\u6709PHQ-9\u95EE\u5377")))
        if (!do::cnOS()) stop(paste0(paste0(years,collapse = ','),' years have no PHQ-9'))
    }
    dpq_var <- c("dpq010","dpq020","dpq030","dpq040","dpq050","dpq060","dpq070","dpq080","dpq090")
    dpq_data <- nhs_read(tsv,dpq_var,varLabel = varLabel,codebook = FALSE,cat = FALSE)
    for (i in dpq_var) dpq_data[dpq_data[,i]>3 & !is.na(dpq_data[,i]),i] <- NA

    qhpscore <- rowSums(dpq_data[,dpq_var],na.rm = TRUE)
    depression <- rep(NA,length(qhpscore))
    allanswer <- rep(NA,length(qhpscore))
    if (missing(cut)) cut <- c(5,10,15,20)
    (cut <- do::increase(cut[!cut %in% c(0,27)]))
    if (length(cut)==0) if(do::cnOS()) stop(tmcn::toUTF8("\u5207\u70B9\u4E0D\u80FD\u662F0\u621627")) else stop('The cut point cannot be 0 or 27')
    for (i in 1:length(cut)){
        if (i==1){
            cuti <- list(c(0,cut[i]-1))
        }else{
            cuti <- c(cuti,list(c(cut[i-1],cut[i]-1)))
        }
        if (i==length(cut)) cuti <- c(cuti,list(c(cut[i],27)))
    }
    cuti

    pb <- txtProgressBar(max=length(qhpscore),width = 30,style = 3)
    for (i in 1:length(qhpscore)) {
        if (i==1) level <- c()
        setTxtProgressBar(pb,i)
        (dpi <- qhpscore[i])
        dpq_data[i,dpq_var]
        (answer <- rowSums(!is.na(dpq_data[i,dpq_var])))
        allanswer[i] <- answer
        if (answer==0) next(i)
        ck <- sapply(cuti, function(j) dpi %in% j[1]:j[2])
        (cut <- cuti[ck][[1]])

        (possible <- dpi:(dpi+3*(9-answer)))
        (ck <- all(possible %in% (cut[1]:cut[2])))
        leveli <- sprintf('[%s,%s]',cut[1],cut[2])
        if (!leveli %in% level) level <- c(level,leveli)
        if (ck){ # SURE
            depression[i] <- leveli
        }else{ # NOT SURE
            if(na0) depression[i] <- leveli
        }
    }
    depression <- factor(depression,levels = level)
    cat('\n\n')
    print(table(answer=allanswer,depression,useNA = 'i'))
    if (score) data_phq9 <- data.frame(seqn=dpq_data$seqn,
                                    Year=dpq_data$Year,
                                    PHQ9=depression,
                                    answer=allanswer,
                                    score=qhpscore,
                                    dpq_data[,c(-1,-2)])
    if (!score) data_phq9 <- data.frame(seqn=dpq_data$seqn,
                                   Year=dpq_data$Year,
                                   PHQ9=depression)
    if (!dpq) data_phq9 <- data_phq9[,!colnames(data_phq9) %in% dpq_var]
    # data_phq9$seqn <- as.numeric(data_phq9$seqn)
    if (missing(data)) return(data_phq9)
    data <- dplyr::left_join(data,data_phq9[,!colnames(data_phq9) %in% 'Year'],'seqn')
    return(data)
}