R/attach_MetS.R
In yikeshu0611/nhanesR: Tools for "NHANES" Database
Defines functions
attach_MetS
Documented in
attach_MetS
#' Attach Metabolic Syndrome
#'
#' @param data data
#' @param years years
#' @param methods ATP or IDF
#' @param cat logical
#'
#' @return data exclude pregnant
#' @export
#' @references
#' Grundy SM, Cleeman JI, Daniels SR, Donato KA, Eckel RH, Franklin BA, Gordon DJ, Krauss RM, Savage PJ, Smith SC Jr, Spertus JA, Costa F; American Heart Association; National Heart, Lung, and Blood Institute. Diagnosis and management of the metabolic syndrome: an American Heart Association/National Heart, Lung, and Blood Institute Scientific Statement. Circulation. 2005 Oct 25;112(17):2735-52. doi: 10.1161/CIRCULATIONAHA.105.169404. Epub 2005 Sep 12. Erratum in: Circulation. 2005 Oct 25;112(17):e297. Erratum in: Circulation. 2005 Oct 25;112(17):e298. PMID: 16157765.
#'
#' Alberti KG, Eckel RH, Grundy SM, et al. Harmonizing the metabolic syndrome: a joint interim statement of the International Diabetes Federation Task Force on Epidemiology and Prevention; National Heart, Lung, and Blood Institute; American Heart Association; World Heart Federation; International Atherosclerosis Society; and International Association for the Study of Obesity. Circulation 2009; 120:1640.
#'
#' Falkner B , Daniels S R . The fourth report on the diagnosis, evaluation, and treatment of high blood pressure in children and adolescents.[J]. Pediatrics, 2004, 44(4):555-576.
attach_MetS <- function(data,years,methods=c('ATP','IDF'),cat=TRUE){
methods <- toupper(methods)
methods <- match.arg(methods)
if (!missing(data)){
years <- unique(data$Year)
seqn <- unique(data$seqn)
}
years <- prepare_years(years)
if(cat) cat('Loading data\n\n')
demo <- nhs_tsv('demo',years = years,cat = FALSE)
gluam <- nhs_tsv('lab10am|l10am_b|l10am_c|glu',items = 'Laboratory',years = years,cat = FALSE)
hdl <- nhs_tsv('lab13\\.|l13_b|l13_c|hdl',years = years,cat = FALSE)
tg <- nhs_tsv('lab18\\.|l40_b|l40_c|biopro',years = years,cat = FALSE)
bmx <- nhs_tsv('bmx',years = years,cat = FALSE)
bpx <- nhs_tsv('bpx','!~bpxo',years = years,cat = FALSE)
n0 <- nhs_read(gluam,'lbxglusi,lbdglusi:glucose',
hdl,'lbdhdlsi,lbdhddsi:hdl',
demo,"riagendr:sex","ridageyr:age",'ridreth1',
tg,'lbdstrsi:tg',
bmx,'bmxwaist:waist','bmxht:height',
bpx,"bpxdi1","bpxdi2","bpxdi3","bpxdi4",
"bpxsy1","bpxsy2","bpxsy3","bpxsy4",
lower_cd = TRUE,cat = FALSE)
n0 <- n0[n0$age>=10,]
n0 <- attach_Pregnant(n0)
n0 <- n0[(n0$pregnant != 'yes') | is.na(n0$pregnant),]
if (!missing(data)) n0 <- n0[n0$seqn %in% seqn,]
if (methods=='ATP'){
# * ATP3 2005 ------------------------------------------------------------
if(cat) cat(crayon::red('ATP3\n'))
if (any(n0$age>=16)){
if(cat) cat(crayon::blue('>=16 years old\n'))
nr <- n0[n0$age>=16,]
# ** glucose ------------------------------------------------------------
if(cat) cat(' Glucose\n')
n1 <- attach_Drug('antidiabet',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
n1$glucose <- ifelse(n1$glucose>=5.6,1,0)
nr$glucose <- rowSums(n1[,c("drug","glucose")],na.rm = TRUE)
nr$glucose <- ifelse(nr$glucose==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","glucose")])) == 2
nr$glucose[ck] <- NA
# ** HDL cholesterol ------------------------------------------------------------
if(cat) cat(' HDL cholesterol\n')
n1 <- attach_Drug('niacin',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
ck <- (nr$sex=='male' & n1$hdl < 1) |
(nr$sex=='female' & n1$hdl < 1.3)
n1$hdl[ck] <- 1
n1$hdl[!ck] <- 0
nr$hdl <- rowSums(n1[,c("drug","hdl")],na.rm = TRUE)
nr$hdl <- ifelse(nr$hdl ==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","hdl")])) == 2
nr$hdl[ck] <- NA
# ** Triglycerides ------------------------------------------------------------
if(cat) cat(' Triglycerides\n')
n1 <- attach_Drug('fibrate',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
n1$tg <- ifelse(n1$tg>1.7,1,0)
nr$tg <- rowSums(n1[,c("drug","tg")],na.rm = TRUE)
nr$tg <- ifelse(nr$tg==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","tg")]))==2
nr$tg[ck] <- NA
# ** Obesity ------------------------------------------------------------
if(cat) cat(' Obesity(Waist)\n')
ck <- (nr$sex == 'male' & nr$waist >= 102) |
(nr$sex == 'female' & nr$waist >= 88)
nr$waist <- ifelse(ck,1,0)
# ** Hypertension ------------------------------------------------------------
if(cat) cat(' Hypertension\n')
dpx <- nr[,c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")] >= 85
dk <- ifelse(rowSums(dpx,na.rm = TRUE)>0,1,0)
dk[rowSums(is.na(dpx))==4] <- NA
dpx <- nr[,c("bpxsy1","bpxsy2","bpxsy3","bpxsy4")] >= 130
sk <- ifelse(rowSums(dpx,na.rm = TRUE)>0,1,0)
sk[rowSums(is.na(dpx))==4] <- NA
nr$dpx <- ifelse((dk+sk) == 2,1,0)
nr <- drop_col(nr,"bpxdi1","bpxdi2","bpxdi3","bpxdi4","bpxsy1","bpxsy2","bpxsy3","bpxsy4")
n1 <- attach_Drug('antihypertensive',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
nr$dpx <- rowSums(n1[,c("drug","dpx")],na.rm = TRUE)
nr$dpx <- ifelse(nr$dpx==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","dpx")]))==2
nr$dpx[ck] <- NA
# * ALL ------------------------------------------------------------
nr$MetS_ATP <- ifelse(rowSums(nr[,c("glucose","hdl","tg","dpx")],na.rm = TRUE) >= 3,'yes','no')
nr$MetS_ATP[rowSums(is.na(nr[,c("glucose","hdl","tg","dpx")]))==4] <- NA
tb <- table(nr$MetS_ATP,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
d <- nr[,c("seqn","Year","MetS_ATP")]
}
if(any(n0$age<16)){
if(cat) cat(crayon::blue('10-16 years old\n'))
# * 10-16 ------------------------------------------------------------
# ** Glucose ------------------------------------------------------------
if(cat) cat(' Glucose\n')
n1 <- attach_DM(nr)
n1$DM[!is.na(n1$DM)] <- 1
nr$glucose <- as.numeric(n1$DM)
# ** hdl ------------------------------------------------------------
if(cat) cat(' HDL cholesterol\n')
Q <- quantile(nr$hdl,0.05,na.rm = TRUE)
nr$hdl <- ifelse(nr$hdl<Q,1,0)
# ** tg ------------------------------------------------------------
if(cat) cat(' Triglycerides\n')
nr <- n0[n0$age<16,]
Q <- quantile(nr$tg,0.95,na.rm = TRUE)
nr$tg <- ifelse(nr$tg>Q,1,0)
# ** BP ------------------------------------------------------------
if(cat) cat(' Blood Pressure(adjusted by sex, age and height)\n')
cutoff <- list(
boy_sys = data.frame(
"10" = c(115, 116, 117, 119, 121, 122, 123),
"11" = c(117, 118, 119, 121, 123, 124, 125),
"12" = c(119, 120, 122, 123, 125, 127, 127),
"13" = c(121, 122, 124, 126, 128, 129, 130),
"14" = c(124, 125, 127, 128, 130, 132, 132),
"15" = c(126, 127, 129, 131, 133, 134, 135),
check.names = FALSE
),
boy_dia = data.frame(
"10" = c(77, 78, 79, 80, 81, 81, 82),
"11" = c(78, 78, 79, 80, 81, 82, 82),
"12" = c(78, 79, 80, 81, 82, 82, 83),
"13" = c(79, 79, 80, 81, 82, 83, 83),
"14" = c(80, 80, 81, 82, 83, 84, 84),
"15" = c(81, 81, 82, 83, 84, 85, 85),
check.names = FALSE
),
girl_sys = data.frame(
"10" = c(116, 116, 117, 119, 120, 121, 122),
"11" = c(118, 118, 119, 121, 122, 123, 124),
"12" = c(119, 120, 121, 123, 124, 125, 126),
"13" = c(121, 122, 123, 124, 126, 127, 128),
"14" = c(123, 123, 125, 126, 127, 129, 129),
"15" = c(124, 125, 126, 127, 129, 130, 131),
check.names = FALSE
),
girl_dia = data.frame(
"10" = c(77, 77, 77, 78, 79, 80, 80),
"11" = c(78, 78, 78, 79, 80, 81, 81),
"12" = c(79, 79, 79, 80, 81, 82, 82),
"13" = c(80, 80, 80, 81, 82, 83, 83),
"14" = c(81, 81, 81, 82, 83, 84, 84),
"15" = c(82, 82, 82, 83, 84, 85, 85),
check.names = FALSE
)
)
for (sexi in c('male','female')) {
for (bpi in c('sys','dia')) {
jk <- cutoff[[paste0(ifelse(sexi=='male','boy_','girl_'),bpi)]]
if (bpi=='sys') bpvar <- c("bpxsy1","bpxsy2","bpxsy3","bpxsy4") else bpvar <- c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")
for (agei in 10:15) {
ck <- nr$sex==sexi & nr$age==agei
Q <- quantile(nr$height[ck],c(0.05,0.1,0.25,0.5,0.75,0.9,0.95),na.rm = TRUE)
for (i in 1:8) {
if (i==1){
ck2 <- ck & nr$height <= Q[1] & !is.na(nr$height)
if (bpi=='sys'){
nr$sysck[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$sysck[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}else{
nr$diack[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$diack[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}
}else if(i <=7){
ck2 <- ck & nr$height <= Q[i] & nr$height > Q[i-1] & !is.na(nr$height)
if (bpi=='sys'){
nr$sysck[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$sysck[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}else{
nr$diack[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$diack[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}
}else{
ck2 <- ck & nr$height > Q[7] & !is.na(nr$height)
if (bpi=='sys'){
nr$sysck[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$sysck[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}else{
nr$diack[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$diack[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}
}
}
}
}
}
nr$bpx <- ifelse(rowSums(nr[,c("sysck","diack")],na.rm = TRUE) >0,1,0)
nr$bpx[rowSums(is.na(nr[,c("sysck","diack")]))==2] <- NA
nr <- drop_col(nr,"bpxdi1","bpxdi2","bpxdi3","bpxdi4","bpxsy1","bpxsy2","bpxsy3","bpxsy4")
nr$MetS_ATP <- ifelse(rowSums(nr[,c("glucose","hdl","tg","bpx")],na.rm = TRUE) >= 3,'yes','no')
nr$MetS_ATP[rowSums(is.na(nr[,c("glucose","hdl","tg","bpx")]))==4] <- NA
tb <- table(nr$MetS_ATP,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
if (any(n0$age>=16)){
d <- rbind(d,nr[,c("seqn","Year","MetS_ATP")])
}else{
d <- nr[,c("seqn","Year","MetS_ATP")]
}
}
if (missing(data)){
data <- d
}else{
d <- d[,c("seqn","MetS_ATP")]
data <- as.data.frame(dplyr::left_join(data,d,'seqn'))
}
return(data)
}else{
if(cat) cat(crayon::red('IDF\n'))
# * IDF 2009 ------------------------------------------------------------
if (any(n0$age>=16)){
if(cat) cat(crayon::blue('>=16 years old\n'))
nr <- n0[n0$age>=16,]
# * glucose ------------------------------------------------------------
if(cat) cat(' Glucose\n')
n1 <- attach_DM(nr)
n1$DM[!is.na(n1$DM) & n1$DM != 'DM'] <- 0
n1$DM[n1$DM == 'DM'] <- 1
n1$DM <- as.numeric(n1$DM)
n1$glucose <- ifelse(n1$glucose>=5.6,1,0)
nr$glucose <- rowSums(n1[,c("DM","glucose")],na.rm = TRUE)
nr$glucose <- ifelse(nr$glucose==0,0,1)
ck <- rowSums(is.na(n1[,c("DM","glucose")])) == 2
nr$glucose[ck] <- NA
# * HDL cholesterol ------------------------------------------------------------
if(cat) cat(' HDL cholesterol\n')
n1 <- attach_Drug('niacin',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
ck <- (nr$sex=='male' & n1$hdl < 1) |
(nr$sex=='female' & n1$hdl < 1.3)
n1$hdl[ck] <- 1
n1$hdl[!ck] <- 0
nr$hdl <- rowSums(n1[,c("drug","hdl")],na.rm = TRUE)
nr$hdl <- ifelse(nr$hdl ==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","hdl")])) == 2
nr$hdl[ck] <- NA
# * Triglycerides ------------------------------------------------------------
if(cat) cat(' Triglycerides\n')
n1 <- attach_Drug('fibrate',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
n1$tg <- ifelse(n1$tg>1.7,1,0)
nr$tg <- rowSums(n1[,c("drug","tg")],na.rm = TRUE)
nr$tg <- ifelse(nr$tg==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","tg")]))==2
nr$tg[ck] <- NA
# * Obesity ------------------------------------------------------------
if(cat) cat(' Obesity(Waist)\n')
ck <- (nr$sex == 'male' & nr$waist >= 94) |
(nr$sex == 'female' & nr$waist >= 80)
nr$waist <- ifelse(ck,1,0)
# * Hypertension ------------------------------------------------------------
if(cat) cat(' Hypertension\n')
bpx <- nr[,c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")] >= 85
dk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
dk[rowSums(is.na(bpx))==4] <- NA
bpx <- nr[,c("bpxsy1","bpxsy2","bpxsy3","bpxsy4")] >= 130
sk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
sk[rowSums(is.na(bpx))==4] <- NA
nr$bpx <- ifelse((dk+sk) == 2,1,0)
nr <- drop_col(nr,"bpxdi1","bpxdi2","bpxdi3","bpxdi4","bpxsy1","bpxsy2","bpxsy3","bpxsy4")
n1 <- attach_Drug('antihypertensive',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
nr$bpx <- rowSums(n1[,c("drug","bpx")],na.rm = TRUE)
nr$bpx <- ifelse(nr$bpx==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","bpx")]))==2
nr$bpx[ck] <- NA
# * ALL ------------------------------------------------------------
nr$MetS_IDF <- ifelse(rowSums(nr[,c("glucose","hdl","tg","bpx")],na.rm = TRUE) >= 3,'yes','no')
nr$MetS_IDF[rowSums(is.na(nr[,c("glucose","hdl","tg","bpx")]))==4] <- NA
tb <- table(nr$MetS_IDF,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
d <- nr[,c("seqn","Year","MetS_IDF")]
}
if (any(n0$age<16)){
if(cat) cat(crayon::blue('10-16 years old\n'))
# * 10-16 ------------------------------------------------------------
nr <- n0[n0$age<16,]
if(cat) cat(' Glucose\n')
nr$glucose <- ifelse(nr$glucose>5.6,1,0)
if(cat) cat(' HDL cholesterol\n')
nr$hdl <- ifelse(nr$hdl<1.03,1,0)
if(cat) cat(' Triglycerides\n')
nr$tg <- ifelse(nr$tg>=1.7,1,0)
# Obesity(Waist,Ethnic-specific, BY ridreth1)
if(cat) cat(' Obesity(Waist,Ethnic-specific, BY ridreth1)\n')
eth <- unique(nr$ridreth1)
for (i in eth) {
ck <- nr$ridreth1 == i
Q <- quantile(nr$waist[ck],0.9,na.rm = T)
nr$waist[ck] <- ifelse(nr$waist[ck]>=Q,1,0)
}
# ** BP ------------------------------------------------------------
if(cat) cat(' Blood Pressure\n')
bpx <- nr[,c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")]>=85
dk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
dk[rowSums(is.na(bpx))==4] <- NA
bpx <- nr[,c("bpxsy1","bpxsy2","bpxsy3","bpxsy4")]>=135
sk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
sk[rowSums(is.na(bpx))==4] <- NA
nr$bpx <- ifelse((dk+sk) > 0,1,0)
nr$bpx[(is.na(dk)+is.na(sk))==2] <- NA
nr$MetS_IDF <- ifelse(rowSums(nr[,c("glucose","hdl","tg",'waist',"bpx")],na.rm = TRUE) >= 2,'yes','no')
nr$MetS_IDF[rowSums(is.na(nr[,c("glucose","hdl","tg",'waist',"bpx")]))==5] <- NA
tb <- table(nr$MetS_IDF,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
if (any(n0$age>=16)){
d <- rbind(d,nr[,c("seqn","Year","MetS_IDF")])
}else{
d <- nr[,c("seqn","Year","MetS_IDF")]
}
}
if (missing(data)){
data <- d
}else{
d <- d[,c("seqn","MetS_IDF")]
data <- as.data.frame(dplyr::left_join(data,d,'seqn'))
}
return(data)
}
}
yikeshu0611/nhanesR documentation built on Jan. 29, 2022, 6:08 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions attach_MetS
Documented in attach_MetS
#' Attach Metabolic Syndrome
#'
#' @param data data
#' @param years years
#' @param methods ATP or IDF
#' @param cat logical
#'
#' @return data exclude pregnant
#' @export
#' @references
#' Grundy SM, Cleeman JI, Daniels SR, Donato KA, Eckel RH, Franklin BA, Gordon DJ, Krauss RM, Savage PJ, Smith SC Jr, Spertus JA, Costa F; American Heart Association; National Heart, Lung, and Blood Institute. Diagnosis and management of the metabolic syndrome: an American Heart Association/National Heart, Lung, and Blood Institute Scientific Statement. Circulation. 2005 Oct 25;112(17):2735-52. doi: 10.1161/CIRCULATIONAHA.105.169404. Epub 2005 Sep 12. Erratum in: Circulation. 2005 Oct 25;112(17):e297. Erratum in: Circulation. 2005 Oct 25;112(17):e298. PMID: 16157765.
#'
#' Alberti KG, Eckel RH, Grundy SM, et al. Harmonizing the metabolic syndrome: a joint interim statement of the International Diabetes Federation Task Force on Epidemiology and Prevention; National Heart, Lung, and Blood Institute; American Heart Association; World Heart Federation; International Atherosclerosis Society; and International Association for the Study of Obesity. Circulation 2009; 120:1640.
#'
#' Falkner B , Daniels S R . The fourth report on the diagnosis, evaluation, and treatment of high blood pressure in children and adolescents.[J]. Pediatrics, 2004, 44(4):555-576.
attach_MetS <- function(data,years,methods=c('ATP','IDF'),cat=TRUE){
methods <- toupper(methods)
methods <- match.arg(methods)
if (!missing(data)){
years <- unique(data$Year)
seqn <- unique(data$seqn)
}
years <- prepare_years(years)
if(cat) cat('Loading data\n\n')
demo <- nhs_tsv('demo',years = years,cat = FALSE)
gluam <- nhs_tsv('lab10am|l10am_b|l10am_c|glu',items = 'Laboratory',years = years,cat = FALSE)
hdl <- nhs_tsv('lab13\\.|l13_b|l13_c|hdl',years = years,cat = FALSE)
tg <- nhs_tsv('lab18\\.|l40_b|l40_c|biopro',years = years,cat = FALSE)
bmx <- nhs_tsv('bmx',years = years,cat = FALSE)
bpx <- nhs_tsv('bpx','!~bpxo',years = years,cat = FALSE)
n0 <- nhs_read(gluam,'lbxglusi,lbdglusi:glucose',
hdl,'lbdhdlsi,lbdhddsi:hdl',
demo,"riagendr:sex","ridageyr:age",'ridreth1',
tg,'lbdstrsi:tg',
bmx,'bmxwaist:waist','bmxht:height',
bpx,"bpxdi1","bpxdi2","bpxdi3","bpxdi4",
"bpxsy1","bpxsy2","bpxsy3","bpxsy4",
lower_cd = TRUE,cat = FALSE)
n0 <- n0[n0$age>=10,]
n0 <- attach_Pregnant(n0)
n0 <- n0[(n0$pregnant != 'yes') | is.na(n0$pregnant),]
if (!missing(data)) n0 <- n0[n0$seqn %in% seqn,]
if (methods=='ATP'){
# * ATP3 2005 ------------------------------------------------------------
if(cat) cat(crayon::red('ATP3\n'))
if (any(n0$age>=16)){
if(cat) cat(crayon::blue('>=16 years old\n'))
nr <- n0[n0$age>=16,]
# ** glucose ------------------------------------------------------------
if(cat) cat(' Glucose\n')
n1 <- attach_Drug('antidiabet',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
n1$glucose <- ifelse(n1$glucose>=5.6,1,0)
nr$glucose <- rowSums(n1[,c("drug","glucose")],na.rm = TRUE)
nr$glucose <- ifelse(nr$glucose==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","glucose")])) == 2
nr$glucose[ck] <- NA
# ** HDL cholesterol ------------------------------------------------------------
if(cat) cat(' HDL cholesterol\n')
n1 <- attach_Drug('niacin',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
ck <- (nr$sex=='male' & n1$hdl < 1) |
(nr$sex=='female' & n1$hdl < 1.3)
n1$hdl[ck] <- 1
n1$hdl[!ck] <- 0
nr$hdl <- rowSums(n1[,c("drug","hdl")],na.rm = TRUE)
nr$hdl <- ifelse(nr$hdl ==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","hdl")])) == 2
nr$hdl[ck] <- NA
# ** Triglycerides ------------------------------------------------------------
if(cat) cat(' Triglycerides\n')
n1 <- attach_Drug('fibrate',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
n1$tg <- ifelse(n1$tg>1.7,1,0)
nr$tg <- rowSums(n1[,c("drug","tg")],na.rm = TRUE)
nr$tg <- ifelse(nr$tg==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","tg")]))==2
nr$tg[ck] <- NA
# ** Obesity ------------------------------------------------------------
if(cat) cat(' Obesity(Waist)\n')
ck <- (nr$sex == 'male' & nr$waist >= 102) |
(nr$sex == 'female' & nr$waist >= 88)
nr$waist <- ifelse(ck,1,0)
# ** Hypertension ------------------------------------------------------------
if(cat) cat(' Hypertension\n')
dpx <- nr[,c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")] >= 85
dk <- ifelse(rowSums(dpx,na.rm = TRUE)>0,1,0)
dk[rowSums(is.na(dpx))==4] <- NA
dpx <- nr[,c("bpxsy1","bpxsy2","bpxsy3","bpxsy4")] >= 130
sk <- ifelse(rowSums(dpx,na.rm = TRUE)>0,1,0)
sk[rowSums(is.na(dpx))==4] <- NA
nr$dpx <- ifelse((dk+sk) == 2,1,0)
nr <- drop_col(nr,"bpxdi1","bpxdi2","bpxdi3","bpxdi4","bpxsy1","bpxsy2","bpxsy3","bpxsy4")
n1 <- attach_Drug('antihypertensive',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
nr$dpx <- rowSums(n1[,c("drug","dpx")],na.rm = TRUE)
nr$dpx <- ifelse(nr$dpx==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","dpx")]))==2
nr$dpx[ck] <- NA
# * ALL ------------------------------------------------------------
nr$MetS_ATP <- ifelse(rowSums(nr[,c("glucose","hdl","tg","dpx")],na.rm = TRUE) >= 3,'yes','no')
nr$MetS_ATP[rowSums(is.na(nr[,c("glucose","hdl","tg","dpx")]))==4] <- NA
tb <- table(nr$MetS_ATP,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
d <- nr[,c("seqn","Year","MetS_ATP")]
}
if(any(n0$age<16)){
if(cat) cat(crayon::blue('10-16 years old\n'))
# * 10-16 ------------------------------------------------------------
# ** Glucose ------------------------------------------------------------
if(cat) cat(' Glucose\n')
n1 <- attach_DM(nr)
n1$DM[!is.na(n1$DM)] <- 1
nr$glucose <- as.numeric(n1$DM)
# ** hdl ------------------------------------------------------------
if(cat) cat(' HDL cholesterol\n')
Q <- quantile(nr$hdl,0.05,na.rm = TRUE)
nr$hdl <- ifelse(nr$hdl<Q,1,0)
# ** tg ------------------------------------------------------------
if(cat) cat(' Triglycerides\n')
nr <- n0[n0$age<16,]
Q <- quantile(nr$tg,0.95,na.rm = TRUE)
nr$tg <- ifelse(nr$tg>Q,1,0)
# ** BP ------------------------------------------------------------
if(cat) cat(' Blood Pressure(adjusted by sex, age and height)\n')
cutoff <- list(
boy_sys = data.frame(
"10" = c(115, 116, 117, 119, 121, 122, 123),
"11" = c(117, 118, 119, 121, 123, 124, 125),
"12" = c(119, 120, 122, 123, 125, 127, 127),
"13" = c(121, 122, 124, 126, 128, 129, 130),
"14" = c(124, 125, 127, 128, 130, 132, 132),
"15" = c(126, 127, 129, 131, 133, 134, 135),
check.names = FALSE
),
boy_dia = data.frame(
"10" = c(77, 78, 79, 80, 81, 81, 82),
"11" = c(78, 78, 79, 80, 81, 82, 82),
"12" = c(78, 79, 80, 81, 82, 82, 83),
"13" = c(79, 79, 80, 81, 82, 83, 83),
"14" = c(80, 80, 81, 82, 83, 84, 84),
"15" = c(81, 81, 82, 83, 84, 85, 85),
check.names = FALSE
),
girl_sys = data.frame(
"10" = c(116, 116, 117, 119, 120, 121, 122),
"11" = c(118, 118, 119, 121, 122, 123, 124),
"12" = c(119, 120, 121, 123, 124, 125, 126),
"13" = c(121, 122, 123, 124, 126, 127, 128),
"14" = c(123, 123, 125, 126, 127, 129, 129),
"15" = c(124, 125, 126, 127, 129, 130, 131),
check.names = FALSE
),
girl_dia = data.frame(
"10" = c(77, 77, 77, 78, 79, 80, 80),
"11" = c(78, 78, 78, 79, 80, 81, 81),
"12" = c(79, 79, 79, 80, 81, 82, 82),
"13" = c(80, 80, 80, 81, 82, 83, 83),
"14" = c(81, 81, 81, 82, 83, 84, 84),
"15" = c(82, 82, 82, 83, 84, 85, 85),
check.names = FALSE
)
)
for (sexi in c('male','female')) {
for (bpi in c('sys','dia')) {
jk <- cutoff[[paste0(ifelse(sexi=='male','boy_','girl_'),bpi)]]
if (bpi=='sys') bpvar <- c("bpxsy1","bpxsy2","bpxsy3","bpxsy4") else bpvar <- c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")
for (agei in 10:15) {
ck <- nr$sex==sexi & nr$age==agei
Q <- quantile(nr$height[ck],c(0.05,0.1,0.25,0.5,0.75,0.9,0.95),na.rm = TRUE)
for (i in 1:8) {
if (i==1){
ck2 <- ck & nr$height <= Q[1] & !is.na(nr$height)
if (bpi=='sys'){
nr$sysck[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$sysck[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}else{
nr$diack[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$diack[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}
}else if(i <=7){
ck2 <- ck & nr$height <= Q[i] & nr$height > Q[i-1] & !is.na(nr$height)
if (bpi=='sys'){
nr$sysck[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$sysck[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}else{
nr$diack[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$diack[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}
}else{
ck2 <- ck & nr$height > Q[7] & !is.na(nr$height)
if (bpi=='sys'){
nr$sysck[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$sysck[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}else{
nr$diack[ck2] <- ifelse(rowSums(nr[ck2,bpvar] >= jk[i,as.character(agei)],na.rm = TRUE)>0,1,0)
nr$diack[ck2][rowSums(is.na(nr[ck2,bpvar]))==4] <- NA
}
}
}
}
}
}
nr$bpx <- ifelse(rowSums(nr[,c("sysck","diack")],na.rm = TRUE) >0,1,0)
nr$bpx[rowSums(is.na(nr[,c("sysck","diack")]))==2] <- NA
nr <- drop_col(nr,"bpxdi1","bpxdi2","bpxdi3","bpxdi4","bpxsy1","bpxsy2","bpxsy3","bpxsy4")
nr$MetS_ATP <- ifelse(rowSums(nr[,c("glucose","hdl","tg","bpx")],na.rm = TRUE) >= 3,'yes','no')
nr$MetS_ATP[rowSums(is.na(nr[,c("glucose","hdl","tg","bpx")]))==4] <- NA
tb <- table(nr$MetS_ATP,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
if (any(n0$age>=16)){
d <- rbind(d,nr[,c("seqn","Year","MetS_ATP")])
}else{
d <- nr[,c("seqn","Year","MetS_ATP")]
}
}
if (missing(data)){
data <- d
}else{
d <- d[,c("seqn","MetS_ATP")]
data <- as.data.frame(dplyr::left_join(data,d,'seqn'))
}
return(data)
}else{
if(cat) cat(crayon::red('IDF\n'))
# * IDF 2009 ------------------------------------------------------------
if (any(n0$age>=16)){
if(cat) cat(crayon::blue('>=16 years old\n'))
nr <- n0[n0$age>=16,]
# * glucose ------------------------------------------------------------
if(cat) cat(' Glucose\n')
n1 <- attach_DM(nr)
n1$DM[!is.na(n1$DM) & n1$DM != 'DM'] <- 0
n1$DM[n1$DM == 'DM'] <- 1
n1$DM <- as.numeric(n1$DM)
n1$glucose <- ifelse(n1$glucose>=5.6,1,0)
nr$glucose <- rowSums(n1[,c("DM","glucose")],na.rm = TRUE)
nr$glucose <- ifelse(nr$glucose==0,0,1)
ck <- rowSums(is.na(n1[,c("DM","glucose")])) == 2
nr$glucose[ck] <- NA
# * HDL cholesterol ------------------------------------------------------------
if(cat) cat(' HDL cholesterol\n')
n1 <- attach_Drug('niacin',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
ck <- (nr$sex=='male' & n1$hdl < 1) |
(nr$sex=='female' & n1$hdl < 1.3)
n1$hdl[ck] <- 1
n1$hdl[!ck] <- 0
nr$hdl <- rowSums(n1[,c("drug","hdl")],na.rm = TRUE)
nr$hdl <- ifelse(nr$hdl ==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","hdl")])) == 2
nr$hdl[ck] <- NA
# * Triglycerides ------------------------------------------------------------
if(cat) cat(' Triglycerides\n')
n1 <- attach_Drug('fibrate',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
n1$tg <- ifelse(n1$tg>1.7,1,0)
nr$tg <- rowSums(n1[,c("drug","tg")],na.rm = TRUE)
nr$tg <- ifelse(nr$tg==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","tg")]))==2
nr$tg[ck] <- NA
# * Obesity ------------------------------------------------------------
if(cat) cat(' Obesity(Waist)\n')
ck <- (nr$sex == 'male' & nr$waist >= 94) |
(nr$sex == 'female' & nr$waist >= 80)
nr$waist <- ifelse(ck,1,0)
# * Hypertension ------------------------------------------------------------
if(cat) cat(' Hypertension\n')
bpx <- nr[,c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")] >= 85
dk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
dk[rowSums(is.na(bpx))==4] <- NA
bpx <- nr[,c("bpxsy1","bpxsy2","bpxsy3","bpxsy4")] >= 130
sk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
sk[rowSums(is.na(bpx))==4] <- NA
nr$bpx <- ifelse((dk+sk) == 2,1,0)
nr <- drop_col(nr,"bpxdi1","bpxdi2","bpxdi3","bpxdi4","bpxsy1","bpxsy2","bpxsy3","bpxsy4")
n1 <- attach_Drug('antihypertensive',data = nr,cat = FALSE,dcn = FALSE,icn = FALSE)
n1$drug[!is.na(n1$drug) & n1$drug != 'other'] <- 1
n1$drug[n1$drug == 'other'] <- 0
n1$drug <- as.numeric(n1$drug)
nr$bpx <- rowSums(n1[,c("drug","bpx")],na.rm = TRUE)
nr$bpx <- ifelse(nr$bpx==0,0,1)
ck <- rowSums(is.na(n1[,c("drug","bpx")]))==2
nr$bpx[ck] <- NA
# * ALL ------------------------------------------------------------
nr$MetS_IDF <- ifelse(rowSums(nr[,c("glucose","hdl","tg","bpx")],na.rm = TRUE) >= 3,'yes','no')
nr$MetS_IDF[rowSums(is.na(nr[,c("glucose","hdl","tg","bpx")]))==4] <- NA
tb <- table(nr$MetS_IDF,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
d <- nr[,c("seqn","Year","MetS_IDF")]
}
if (any(n0$age<16)){
if(cat) cat(crayon::blue('10-16 years old\n'))
# * 10-16 ------------------------------------------------------------
nr <- n0[n0$age<16,]
if(cat) cat(' Glucose\n')
nr$glucose <- ifelse(nr$glucose>5.6,1,0)
if(cat) cat(' HDL cholesterol\n')
nr$hdl <- ifelse(nr$hdl<1.03,1,0)
if(cat) cat(' Triglycerides\n')
nr$tg <- ifelse(nr$tg>=1.7,1,0)
# Obesity(Waist,Ethnic-specific, BY ridreth1)
if(cat) cat(' Obesity(Waist,Ethnic-specific, BY ridreth1)\n')
eth <- unique(nr$ridreth1)
for (i in eth) {
ck <- nr$ridreth1 == i
Q <- quantile(nr$waist[ck],0.9,na.rm = T)
nr$waist[ck] <- ifelse(nr$waist[ck]>=Q,1,0)
}
# ** BP ------------------------------------------------------------
if(cat) cat(' Blood Pressure\n')
bpx <- nr[,c("bpxdi1","bpxdi2","bpxdi3","bpxdi4")]>=85
dk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
dk[rowSums(is.na(bpx))==4] <- NA
bpx <- nr[,c("bpxsy1","bpxsy2","bpxsy3","bpxsy4")]>=135
sk <- ifelse(rowSums(bpx,na.rm = TRUE)>0,1,0)
sk[rowSums(is.na(bpx))==4] <- NA
nr$bpx <- ifelse((dk+sk) > 0,1,0)
nr$bpx[(is.na(dk)+is.na(sk))==2] <- NA
nr$MetS_IDF <- ifelse(rowSums(nr[,c("glucose","hdl","tg",'waist',"bpx")],na.rm = TRUE) >= 2,'yes','no')
nr$MetS_IDF[rowSums(is.na(nr[,c("glucose","hdl","tg",'waist',"bpx")]))==5] <- NA
tb <- table(nr$MetS_IDF,useNA = 'i')
if(cat) cat(paste0(' MetS: ',paste0(paste0(names(tb),':',tb),collapse = ', ')),'\n')
if (any(n0$age>=16)){
d <- rbind(d,nr[,c("seqn","Year","MetS_IDF")])
}else{
d <- nr[,c("seqn","Year","MetS_IDF")]
}
}
if (missing(data)){
data <- d
}else{
d <- d[,c("seqn","MetS_IDF")]
data <- as.data.frame(dplyr::left_join(data,d,'seqn'))
}
return(data)
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.