R/attach_Frailty.R
In yikeshu0611/nhanesR: Tools for "NHANES" Database
Defines functions
attach_Frailty
Documented in
attach_Frailty
#' Frailty Index
#'
#' @param data data
#' @param years years
#' @param component logical. whether to keep 53 components
#' @references
#' Hakeem F F , E Bernabé, Sabba H W . Association Between Oral Health and Frailty Among American Older Adults[J]. Journal of the American Medical Directors Association, 2020, 22(s1).
#' Searle S D , Mitnitski A , Gahbauer E A , et al. A standard procedure for creating a frailty index[J]. Bmc Geriatrics, 2008, 8(1):24-24.
#' @export
#' @details
#' run Frailty53()
#'
attach_Frailty <- function(data,years,component=FALSE){
years <- data_years(data,years)
(demo <- nhs_tsv('demo',years=years,cat=FALSE))
(pfq <- nhs_tsv('pfq',years=years,cat=FALSE))
(dpq <- c(nhs_tsv('ciq','dep',years=years,cat=FALSE),
nhs_tsv('dpq',years=years,cat=FALSE)))
(mcq <- nhs_tsv('mcq',years=years,cat=FALSE))
(bpq <- nhs_tsv('bpq',years=years,cat=FALSE))
(diq <- nhs_tsv('diq',years=years,cat=FALSE))
(kiq <- nhs_tsv('kiq\\.|kiq_u',years=years,cat=FALSE))
(bmx <- nhs_tsv('bmx',years=years,cat=FALSE))
(huq <- nhs_tsv('huq',years=years,cat=FALSE))
(ghb <- nhs_tsv('lab10\\.|l10_b|l10_c|ghb',years=years,cat=FALSE))
(rbc <- nhs_tsv('lab25\\.|l25_b|l25_c|cbc',years=years,cat=FALSE))
(rxq_rx <- nhs_tsv('rxq_rx',years=years,cat=FALSE))
# (mgx <- nhs_tsv('mgx',years=years,cat=FALSE)) for grip force
nr <- nhs_read(
demo,"riagendr:sex",
pfq,
'pfq056,pfq057:Experience_confusion_memory_problems',# 1. Experience confusion/memory problems
'pfq060a,pfq061a:money_manage', # 2. Managing money difficulty
'pfq060b,pfq061b:walking_for_a_quarter_mile', # 3. walking for a quarter mile difficulty
'pfq060c,pfq061c:walking_up_ten_steps', # 4. walking up ten steps difficulty
'pfq060d,pfq061d:stoop_crouch_kneel', # 5. Stooping, crouching, kneeling difficulty
'pfq060e,pfq061e:lifting_carry', # 6. lifting or carrying difficulty
'pfq060f,pfq061f:house_chore', # 7. house chore difficulty
'pfq060g,pfq061g:preparing_meals', # 8. preparing meals difficulty
'pfq060h,pfq061h:walking_between_rooms_on_same_floor', # 9. walking between rooms on same floor
'pfq060i,pfq061i:standingup_from_armless_chair', # 9. standingup from armless chair difficulty
'pfq060j,pfq061j:getting_in_and_out_of_bed', # 10. getting in and out of bed difficulty
'pfq060k,pfq061k:using_fork_knife_drinking', # 11. using fork, knife, drinking from cup
'pfq060l,pfq061l:dressing_yourself', # 12. dressing yourself difficulty
'pfq060m,pfq061m:standing_for_long_periods', # 13. standing for long periods difficulty
'pfq060n,pfq061n:sitting_for_long_periods_difficulty', # 14. sitting for long periods difficulty
'pfq060o,pfq061o:reaching_up_over_head_difficulty', # 15. reaching up over head difficulty
'pfq060p,pfq061p:grasp_holding_small_objects', # 14. grasp/holding small objects difficulty
'pfq060q,pfq061q:going_out_to_movies_events_difficulty', # 15. going out to movies, events difficulty
'pfq060r,pfq061r:attending_social_event', # 15. attending social event difficulty
'pfq060s,pfq061s:leisure_activity_at_home_difficulty', # 16. leisure activity at home difficulty
'pfq061t:push_or_pull_large_objects', # 16. push or pull large objects difficulty
dpq,
'dpq010,ciqd009:little_interest_in_doing_things', # 17. little interest in doing things
'ciqd008',
'dpq020,ciqd002:feeling_down_depressed_or_hopeless', # 18. feeling down, depressed, or hopeless
'ciqd001',
'dpq030,ciqd026:Trouble_sleeping_or_sleeping_too_much', # 19. Trouble sleeping or sleeping too much
'ciqd025',
'dpq040:Feeling_tired_or_having_little_energy', # 20. Feeling tired or having little energy
'dpq050,ciqd019:Poor_appetite_or_overeating', # 21. Poor appetite or overeating
'ciqd022',
'dpq060,ciqd029:Feeling_bad_about_yourself', # 22. Feeling bad about yourself
'dpq070,ciqd043:Trouble_concentrating_on_things', # 23. Trouble concentrating on things
mcq,
'mcq160a:arthritis', # 24. ever had arthritis
'mcq160i,mcd160m,mcq160m:thyroid', # 25. ever had thyroid problem
'mcq160k,mcq160p:chronic_bronchitis', # 26. ever had chronic bronchitis
'mcq220:cancer', # 27. ever had cancer
'mcq160b:Congestive_heart_failure', # 28. Congestive heart failure
'mcq160c:Coronary_heart_disease', # 29. Coronary heart disease
'mcq160d:angina', # 30. angina
'mcq160e:heart_attack', # 31. heart attack
'mcq160f:stroke', # 32. stroke
bpq,'bpq020:high_blood_pressure', # 33. high blood pressure
diq,'diq010:diabetes', # 34. diabetes
kiq,'kiq020,kiq022:weak_kidneys', # 35. weak/failing kidneys
'kiq040,kiq050:urinary_leakage', # 36. urinary leakage
huq,
'huq010:general_health_condition', # 37. self-reported general health condition
'huq020:health_compared_1_year_ago', # 38. health now compared with 1 year ago
'huq070,hud070,huq071:overnight_hospital_patient', # 39. overnight hospital patient in last year
'huq050,huq051:times_receive_healthcare_over_past_year', # 40. Frequency of health care use during past year
bmx,'bmxbmi', # 42. BMI Body mass index
# mgx, # 43. grip force
# 'mgxh1t1','mgxh1t2','mgxh1t3','mgxh2t1','mgxh2t2','mgxh2t3',
ghb,'lbxgh:glycohemoglobin', # 44. glycohemoglobin
rbc,
'lbxrbcsi:rbc', # 45. red blood cell count (million cells/ul)
'lbxhgb:Hemoglobin', # 46. Hemoglobin (g/dL)
'lbxrdw:Red_cell_distribution_width', # 47. Red cell distribution width (%)
'lbxlypct:Lymphocyte_percent', # 48. Lymphocyte percent
'lbxnepct:segmented_neutrophils_percent', # 49. segmented neutrophils percent
lower_cd = TRUE,cat=FALSE)
x <- nhs_read(rxq_rx,'rxd295,rxdcount:prescribed_medications',cat=FALSE)[,c('seqn','prescribed_medications')]
x <- aggregate(x = x$prescribed_medications,by=list(seqn=x$seqn),sum,na.rm=TRUE)
colnames(x)[2] <- 'prescribed_medications'
nr <- dplyr::left_join(nr,x,'seqn')
nr <- to_NA(nr)
# * p1 ------------------------------------------------------------
p1 <- c('Experience_confusion_memory_problems',
'money_manage',
'walking_for_a_quarter_mile',
'walking_up_ten_steps',
'stoop_crouch_kneel',
'lifting_carry',
'house_chore',
'preparing_meals',
'walking_between_rooms_on_same_floor',
'standingup_from_armless_chair',
'getting_in_and_out_of_bed',
'using_fork_knife_drinking',
'dressing_yourself',
'standing_for_long_periods',
'sitting_for_long_periods_difficulty',
'reaching_up_over_head_difficulty',
'grasp_holding_small_objects',
'going_out_to_movies_events_difficulty',
'attending_social_event',
'leisure_activity_at_home_difficulty',
'push_or_pull_large_objects')
p1d <- nr[,p1]
p1d[p1d=='no'] <- 0
p1d[p1d=='yes'] <- 1
p1d <- do::Replace(p1d,' {2,}',' ')
p1d[p1d=='do not do this activity'] <- NA
p1d[p1d=='no difficulty'] <- 0
p1d[p1d=='some difficulty'] <- 0.33
p1d[p1d=='much difficulty'] <- 0.66
p1d[p1d=='unable to do'] <- 1
# lapply(p1d, do::unique_no.NA)
nr[,p1] <- p1d
# * p2 ------------------------------------------------------------
p2 <- c('little_interest_in_doing_things',
'ciqd008',
'feeling_down_depressed_or_hopeless',
'ciqd001',
'Trouble_sleeping_or_sleeping_too_much',
'ciqd025',
'Feeling_tired_or_having_little_energy',
'Poor_appetite_or_overeating',
'ciqd022',
'Feeling_bad_about_yourself',
'Trouble_concentrating_on_things')
p2d <- nr[,colnames(nr) %in% p2]
if ('ciqd008' %in% colnames(p2d)) p2d$little_interest_in_doing_things[p2d$ciqd008=='no'] <- '0'
if ('ciqd001' %in% colnames(p2d)) p2d$feeling_down_depressed_or_hopeless[p2d$ciqd001=='no'] <- '0'
if ('ciqd025' %in% colnames(p2d)) p2d$Trouble_sleeping_or_sleeping_too_much[p2d$ciqd025=='no'] <- '0'
if ('ciqd022' %in% colnames(p2d)) p2d$Poor_appetite_or_overeating[p2d$ciqd022=='no'] <- '0'
if ('ciqd022' %in% colnames(p2d)) p2d$Poor_appetite_or_overeating[p2d$ciqd022=='yes'] <- '1'
p2d[p2d=='no'] <- 0
p2d[p2d=='not at all'] <- 0
p2d[p2d=='yes'] <- 1
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='every day'] = '1.00'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='most days'] = '0.75'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='about half the days'] = '0.50'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='less than half the days'] = '0.25'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='nearly every day'] = '1.00'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='more than half the days'] = '0.66'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='several days'] = '0.33'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='every day'] = '1.00'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='most days'] = '0.75'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='about half the days'] = '0.50'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='less than half the days'] = '0.25'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='nearly every day'] = '1.00'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='more than half the days'] = '0.66'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='several days'] = '0.33'
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='every night'] <- 1.00
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='nearly every night'] <- 0.66
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='less often'] <- 0.33
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='nearly every day'] <- 1.00
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='more than half the days'] <- 0.66
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='several days'] <- 0.33
p2d$Feeling_tired_or_having_little_energy[p2d$Feeling_tired_or_having_little_energy=='nearly every day'] <- 1.00
p2d$Feeling_tired_or_having_little_energy[p2d$Feeling_tired_or_having_little_energy=='more than half the days'] <- 0.66
p2d$Feeling_tired_or_having_little_energy[p2d$Feeling_tired_or_having_little_energy=='several days'] <- 0.33
p2d$Poor_appetite_or_overeating[p2d$Poor_appetite_or_overeating=='nearly every day'] <- 1.00
p2d$Poor_appetite_or_overeating[p2d$Poor_appetite_or_overeating=='more than half the days'] <- 0.66
p2d$Poor_appetite_or_overeating[p2d$Poor_appetite_or_overeating=='several days'] <- 0.33
p2d$Feeling_bad_about_yourself[p2d$Feeling_bad_about_yourself=='nearly every day'] <- 1.00
p2d$Feeling_bad_about_yourself[p2d$Feeling_bad_about_yourself=='more than half the days'] <- 0.66
p2d$Feeling_bad_about_yourself[p2d$Feeling_bad_about_yourself=='several days'] <- 0.33
p2d$Trouble_concentrating_on_things[p2d$Trouble_concentrating_on_things=='nearly every day'] <- 1.00
p2d$Trouble_concentrating_on_things[p2d$Trouble_concentrating_on_things=='more than half the days'] <- 0.66
p2d$Trouble_concentrating_on_things[p2d$Trouble_concentrating_on_things=='several days'] <- 0.33
nr[,colnames(nr) %in% p2] <- p2d
nr <- drop_col(nr,c('ciqd008','ciqd001','ciqd025','ciqd022'))
# * p3 ------------------------------------------------------------
p3 <- c('arthritis','thyroid','chronic_bronchitis','cancer',
'Congestive_heart_failure','Coronary_heart_disease',
'angina','heart_attack','stroke','high_blood_pressure',
'diabetes','weak_kidneys','urinary_leakage')
p3d <- nr[,p3]
p3d[p3d=='no'] <- 0
p3d[p3d=="not at all"] <- 0
p3d[p3d=='borderline'] <- 0.5
p3d[p3d=='yes'] <- 1
p3d$urinary_leakage[p3d$urinary_leakage=='greatly'] = '1.00'
p3d$urinary_leakage[p3d$urinary_leakage=='very much'] = '0.75'
p3d$urinary_leakage[p3d$urinary_leakage=='somewhat'] ='0.50'
p3d$urinary_leakage[p3d$urinary_leakage=='only a little'] = '0.25'
nr[,p3] <- p3d
# * p4 ------------------------------------------------------------
p4 <- c('general_health_condition',
'health_compared_1_year_ago',
'overnight_hospital_patient',
'times_receive_healthcare_over_past_year',
'prescribed_medications')
p4d <- nr[,p4]
p4d$general_health_condition <- ifelse(p4d$general_health_condition %in% c('excellent','very good','good'),0,1)
p4d$health_compared_1_year_ago <- ifelse(p4d$health_compared_1_year_ago %in% 'worse, or',1,0)
p4d$overnight_hospital_patient <- ifelse(p4d$overnight_hospital_patient == 'yes',1,0)
p4d$times_receive_healthcare_over_past_year |> do::unique_no.NA() |> do::increase()
p4d$times_receive_healthcare_over_past_year[p4d$times_receive_healthcare_over_past_year=='none'] <- 0
p4d$times_receive_healthcare_over_past_year <- p4d$times_receive_healthcare_over_past_year |> do::Replace0(' {0,}[a-z].*') |> as.numeric()
p4d$times_receive_healthcare_over_past_year <- ifelse(p4d$times_receive_healthcare_over_past_year == 0,0,
ifelse(p4d$times_receive_healthcare_over_past_year<=4 & p4d$times_receive_healthcare_over_past_year,0.5,1))
p4d$prescribed_medications <- ifelse(p4d$prescribed_medications>=5,1,0.5)
p4d$prescribed_medications[is.na(p4d$prescribed_medications)] <- 0
nr[,p4] <- p4d
# * p5 ------------------------------------------------------------
nr$bmxbmi <- ifelse(nr$bmxbmi <18.5 & nr$bmxbmi >=30,1,
ifelse(nr$bmxbmi >=25 & nr$bmxbmi <30,0.5,0))
# hg <- rowSums(nr[,c('mgxh1t1','mgxh1t2','mgxh1t3','mgxh2t1','mgxh2t2','mgxh2t3')],na.rm = TRUE)
# hgf <- (1:nrow(nr))[hg>0]
# nr$grip_force[hgf] <- sapply(hgf,function(i) max(nr[i,c('mgxh1t1','mgxh1t2','mgxh1t3','mgxh2t1','mgxh2t2','mgxh2t3')],na.rm = TRUE))
# nr$grip_force[hg==0 | is.na(nr$bmxbmi) | is.na(nr$sex)] <- NA # not test grip force
#
# ck1 <- (nr$sex=='male' & nr$bmxbmi <= 24 & nr$grip_force <= 29) |
# (nr$sex=='male' & nr$bmxbmi > 24 & nr$bmxbmi <= 28 & nr$grip_force <= 30) |
# (nr$sex=='male' & nr$bmxbmi > 28 & nr$grip_force <= 32) |
#
# (nr$sex=='female' & nr$bmxbmi <= 23 & nr$grip_force <= 17) |
# (nr$sex=='female' & nr$bmxbmi > 23 & nr$bmxbmi <= 26 & nr$grip_force <= 17.3) |
# (nr$sex=='female' & nr$bmxbmi > 26 & nr$bmxbmi <= 29 & nr$grip_force <= 18) |
# (nr$sex=='female' & nr$bmxbmi > 29 & nr$grip_force <= 21)
#
# nr$grip_force[ck1] <- 1
# nr$grip_force[!ck1] <- 0
# * p6 ------------------------------------------------------------
nr$glycohemoglobin <- ifelse(nr$glycohemoglobin>5.7,1,0)
# 45
ck0 <- (nr$sex=='male' & nr$rbc >= 4.7 & nr$rbc < 6.1) |
(nr$sex=='female' & nr$rbc >= 4.2 & nr$rbc < 5.4)
nr$rbc <- ifelse(ck0,0,1)
# 46
ck0 <- (nr$sex == 'male' & nr$Hemoglobin >= 13.5 & nr$Hemoglobin < 18) |
(nr$sex == 'female' & nr$Hemoglobin >= 12 & nr$Hemoglobin < 16)
nr$Hemoglobin <- ifelse(ck0,0,1)
# 47
nr$Red_cell_distribution_width <- ifelse(nr$Red_cell_distribution_width >= 11.6 & nr$Red_cell_distribution_width < 14.6,0,1)
# 48
nr$Lymphocyte_percent <- ifelse(nr$Lymphocyte_percent >= 20 & nr$Lymphocyte_percent < 40,0,1)
# 49
nr$segmented_neutrophils_percent <- ifelse(nr$segmented_neutrophils_percent >= 40 & nr$segmented_neutrophils_percent < 80,0,1)
# * score ------------------------------------------------------------
nr <- drop_col(nr,'sex','rxddrgid')
for (i in 3:ncol(nr)) {
x <- tryCatch(as.numeric(nr[,i]),warning=function(w) 'e')
if (x[!is.na(x)][1]=='e') stop()
nr[,i] <- x
}
p7 <- c("Experience_confusion_memory_problems", "money_manage", "walking_for_a_quarter_mile",
"walking_up_ten_steps", "stoop_crouch_kneel", "lifting_carry",
"house_chore", "preparing_meals", "walking_between_rooms_on_same_floor",
"standingup_from_armless_chair", "getting_in_and_out_of_bed",
"using_fork_knife_drinking", "dressing_yourself", "standing_for_long_periods",
"sitting_for_long_periods_difficulty", "reaching_up_over_head_difficulty",
"grasp_holding_small_objects", "going_out_to_movies_events_difficulty",
"attending_social_event", "leisure_activity_at_home_difficulty",
"little_interest_in_doing_things", "feeling_down_depressed_or_hopeless",
"Trouble_sleeping_or_sleeping_too_much", "Poor_appetite_or_overeating",
"Feeling_bad_about_yourself", "Trouble_concentrating_on_things",
"arthritis", "thyroid", "chronic_bronchitis", "cancer", "Congestive_heart_failure",
"Coronary_heart_disease", "angina", "heart_attack", "stroke",
"high_blood_pressure", "diabetes", "weak_kidneys", "urinary_leakage",
"general_health_condition", "health_compared_1_year_ago", "overnight_hospital_patient",
"times_receive_healthcare_over_past_year", "prescribed_medications",
"bmxbmi", "glycohemoglobin", "rbc", "Hemoglobin", "Red_cell_distribution_width",
"Lymphocyte_percent", "segmented_neutrophils_percent", "push_or_pull_large_objects",
"Feeling_tired_or_having_little_energy")
p7d <- nr[,p7]
nr$frailty_number <- rowSums(!is.na(p7d))
nr$frailty_score <- rowSums(p7d,na.rm = TRUE) / nr$frailty_number
if (!component) nr <- drop_col(nr,p7)
if (missing(data)){
data <- nr
}else{
data0 <- nr[,!colnames(nr) %in% 'Year']
data <- dplyr::left_join(data,data0,'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_Frailty
Documented in attach_Frailty
#' Frailty Index
#'
#' @param data data
#' @param years years
#' @param component logical. whether to keep 53 components
#' @references
#' Hakeem F F , E Bernabé, Sabba H W . Association Between Oral Health and Frailty Among American Older Adults[J]. Journal of the American Medical Directors Association, 2020, 22(s1).
#' Searle S D , Mitnitski A , Gahbauer E A , et al. A standard procedure for creating a frailty index[J]. Bmc Geriatrics, 2008, 8(1):24-24.
#' @export
#' @details
#' run Frailty53()
#'
attach_Frailty <- function(data,years,component=FALSE){
years <- data_years(data,years)
(demo <- nhs_tsv('demo',years=years,cat=FALSE))
(pfq <- nhs_tsv('pfq',years=years,cat=FALSE))
(dpq <- c(nhs_tsv('ciq','dep',years=years,cat=FALSE),
nhs_tsv('dpq',years=years,cat=FALSE)))
(mcq <- nhs_tsv('mcq',years=years,cat=FALSE))
(bpq <- nhs_tsv('bpq',years=years,cat=FALSE))
(diq <- nhs_tsv('diq',years=years,cat=FALSE))
(kiq <- nhs_tsv('kiq\\.|kiq_u',years=years,cat=FALSE))
(bmx <- nhs_tsv('bmx',years=years,cat=FALSE))
(huq <- nhs_tsv('huq',years=years,cat=FALSE))
(ghb <- nhs_tsv('lab10\\.|l10_b|l10_c|ghb',years=years,cat=FALSE))
(rbc <- nhs_tsv('lab25\\.|l25_b|l25_c|cbc',years=years,cat=FALSE))
(rxq_rx <- nhs_tsv('rxq_rx',years=years,cat=FALSE))
# (mgx <- nhs_tsv('mgx',years=years,cat=FALSE)) for grip force
nr <- nhs_read(
demo,"riagendr:sex",
pfq,
'pfq056,pfq057:Experience_confusion_memory_problems',# 1. Experience confusion/memory problems
'pfq060a,pfq061a:money_manage', # 2. Managing money difficulty
'pfq060b,pfq061b:walking_for_a_quarter_mile', # 3. walking for a quarter mile difficulty
'pfq060c,pfq061c:walking_up_ten_steps', # 4. walking up ten steps difficulty
'pfq060d,pfq061d:stoop_crouch_kneel', # 5. Stooping, crouching, kneeling difficulty
'pfq060e,pfq061e:lifting_carry', # 6. lifting or carrying difficulty
'pfq060f,pfq061f:house_chore', # 7. house chore difficulty
'pfq060g,pfq061g:preparing_meals', # 8. preparing meals difficulty
'pfq060h,pfq061h:walking_between_rooms_on_same_floor', # 9. walking between rooms on same floor
'pfq060i,pfq061i:standingup_from_armless_chair', # 9. standingup from armless chair difficulty
'pfq060j,pfq061j:getting_in_and_out_of_bed', # 10. getting in and out of bed difficulty
'pfq060k,pfq061k:using_fork_knife_drinking', # 11. using fork, knife, drinking from cup
'pfq060l,pfq061l:dressing_yourself', # 12. dressing yourself difficulty
'pfq060m,pfq061m:standing_for_long_periods', # 13. standing for long periods difficulty
'pfq060n,pfq061n:sitting_for_long_periods_difficulty', # 14. sitting for long periods difficulty
'pfq060o,pfq061o:reaching_up_over_head_difficulty', # 15. reaching up over head difficulty
'pfq060p,pfq061p:grasp_holding_small_objects', # 14. grasp/holding small objects difficulty
'pfq060q,pfq061q:going_out_to_movies_events_difficulty', # 15. going out to movies, events difficulty
'pfq060r,pfq061r:attending_social_event', # 15. attending social event difficulty
'pfq060s,pfq061s:leisure_activity_at_home_difficulty', # 16. leisure activity at home difficulty
'pfq061t:push_or_pull_large_objects', # 16. push or pull large objects difficulty
dpq,
'dpq010,ciqd009:little_interest_in_doing_things', # 17. little interest in doing things
'ciqd008',
'dpq020,ciqd002:feeling_down_depressed_or_hopeless', # 18. feeling down, depressed, or hopeless
'ciqd001',
'dpq030,ciqd026:Trouble_sleeping_or_sleeping_too_much', # 19. Trouble sleeping or sleeping too much
'ciqd025',
'dpq040:Feeling_tired_or_having_little_energy', # 20. Feeling tired or having little energy
'dpq050,ciqd019:Poor_appetite_or_overeating', # 21. Poor appetite or overeating
'ciqd022',
'dpq060,ciqd029:Feeling_bad_about_yourself', # 22. Feeling bad about yourself
'dpq070,ciqd043:Trouble_concentrating_on_things', # 23. Trouble concentrating on things
mcq,
'mcq160a:arthritis', # 24. ever had arthritis
'mcq160i,mcd160m,mcq160m:thyroid', # 25. ever had thyroid problem
'mcq160k,mcq160p:chronic_bronchitis', # 26. ever had chronic bronchitis
'mcq220:cancer', # 27. ever had cancer
'mcq160b:Congestive_heart_failure', # 28. Congestive heart failure
'mcq160c:Coronary_heart_disease', # 29. Coronary heart disease
'mcq160d:angina', # 30. angina
'mcq160e:heart_attack', # 31. heart attack
'mcq160f:stroke', # 32. stroke
bpq,'bpq020:high_blood_pressure', # 33. high blood pressure
diq,'diq010:diabetes', # 34. diabetes
kiq,'kiq020,kiq022:weak_kidneys', # 35. weak/failing kidneys
'kiq040,kiq050:urinary_leakage', # 36. urinary leakage
huq,
'huq010:general_health_condition', # 37. self-reported general health condition
'huq020:health_compared_1_year_ago', # 38. health now compared with 1 year ago
'huq070,hud070,huq071:overnight_hospital_patient', # 39. overnight hospital patient in last year
'huq050,huq051:times_receive_healthcare_over_past_year', # 40. Frequency of health care use during past year
bmx,'bmxbmi', # 42. BMI Body mass index
# mgx, # 43. grip force
# 'mgxh1t1','mgxh1t2','mgxh1t3','mgxh2t1','mgxh2t2','mgxh2t3',
ghb,'lbxgh:glycohemoglobin', # 44. glycohemoglobin
rbc,
'lbxrbcsi:rbc', # 45. red blood cell count (million cells/ul)
'lbxhgb:Hemoglobin', # 46. Hemoglobin (g/dL)
'lbxrdw:Red_cell_distribution_width', # 47. Red cell distribution width (%)
'lbxlypct:Lymphocyte_percent', # 48. Lymphocyte percent
'lbxnepct:segmented_neutrophils_percent', # 49. segmented neutrophils percent
lower_cd = TRUE,cat=FALSE)
x <- nhs_read(rxq_rx,'rxd295,rxdcount:prescribed_medications',cat=FALSE)[,c('seqn','prescribed_medications')]
x <- aggregate(x = x$prescribed_medications,by=list(seqn=x$seqn),sum,na.rm=TRUE)
colnames(x)[2] <- 'prescribed_medications'
nr <- dplyr::left_join(nr,x,'seqn')
nr <- to_NA(nr)
# * p1 ------------------------------------------------------------
p1 <- c('Experience_confusion_memory_problems',
'money_manage',
'walking_for_a_quarter_mile',
'walking_up_ten_steps',
'stoop_crouch_kneel',
'lifting_carry',
'house_chore',
'preparing_meals',
'walking_between_rooms_on_same_floor',
'standingup_from_armless_chair',
'getting_in_and_out_of_bed',
'using_fork_knife_drinking',
'dressing_yourself',
'standing_for_long_periods',
'sitting_for_long_periods_difficulty',
'reaching_up_over_head_difficulty',
'grasp_holding_small_objects',
'going_out_to_movies_events_difficulty',
'attending_social_event',
'leisure_activity_at_home_difficulty',
'push_or_pull_large_objects')
p1d <- nr[,p1]
p1d[p1d=='no'] <- 0
p1d[p1d=='yes'] <- 1
p1d <- do::Replace(p1d,' {2,}',' ')
p1d[p1d=='do not do this activity'] <- NA
p1d[p1d=='no difficulty'] <- 0
p1d[p1d=='some difficulty'] <- 0.33
p1d[p1d=='much difficulty'] <- 0.66
p1d[p1d=='unable to do'] <- 1
# lapply(p1d, do::unique_no.NA)
nr[,p1] <- p1d
# * p2 ------------------------------------------------------------
p2 <- c('little_interest_in_doing_things',
'ciqd008',
'feeling_down_depressed_or_hopeless',
'ciqd001',
'Trouble_sleeping_or_sleeping_too_much',
'ciqd025',
'Feeling_tired_or_having_little_energy',
'Poor_appetite_or_overeating',
'ciqd022',
'Feeling_bad_about_yourself',
'Trouble_concentrating_on_things')
p2d <- nr[,colnames(nr) %in% p2]
if ('ciqd008' %in% colnames(p2d)) p2d$little_interest_in_doing_things[p2d$ciqd008=='no'] <- '0'
if ('ciqd001' %in% colnames(p2d)) p2d$feeling_down_depressed_or_hopeless[p2d$ciqd001=='no'] <- '0'
if ('ciqd025' %in% colnames(p2d)) p2d$Trouble_sleeping_or_sleeping_too_much[p2d$ciqd025=='no'] <- '0'
if ('ciqd022' %in% colnames(p2d)) p2d$Poor_appetite_or_overeating[p2d$ciqd022=='no'] <- '0'
if ('ciqd022' %in% colnames(p2d)) p2d$Poor_appetite_or_overeating[p2d$ciqd022=='yes'] <- '1'
p2d[p2d=='no'] <- 0
p2d[p2d=='not at all'] <- 0
p2d[p2d=='yes'] <- 1
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='every day'] = '1.00'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='most days'] = '0.75'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='about half the days'] = '0.50'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='less than half the days'] = '0.25'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='nearly every day'] = '1.00'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='more than half the days'] = '0.66'
p2d$little_interest_in_doing_things[p2d$little_interest_in_doing_things=='several days'] = '0.33'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='every day'] = '1.00'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='most days'] = '0.75'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='about half the days'] = '0.50'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='less than half the days'] = '0.25'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='nearly every day'] = '1.00'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='more than half the days'] = '0.66'
p2d$feeling_down_depressed_or_hopeless[p2d$feeling_down_depressed_or_hopeless=='several days'] = '0.33'
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='every night'] <- 1.00
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='nearly every night'] <- 0.66
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='less often'] <- 0.33
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='nearly every day'] <- 1.00
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='more than half the days'] <- 0.66
p2d$Trouble_sleeping_or_sleeping_too_much[p2d$Trouble_sleeping_or_sleeping_too_much=='several days'] <- 0.33
p2d$Feeling_tired_or_having_little_energy[p2d$Feeling_tired_or_having_little_energy=='nearly every day'] <- 1.00
p2d$Feeling_tired_or_having_little_energy[p2d$Feeling_tired_or_having_little_energy=='more than half the days'] <- 0.66
p2d$Feeling_tired_or_having_little_energy[p2d$Feeling_tired_or_having_little_energy=='several days'] <- 0.33
p2d$Poor_appetite_or_overeating[p2d$Poor_appetite_or_overeating=='nearly every day'] <- 1.00
p2d$Poor_appetite_or_overeating[p2d$Poor_appetite_or_overeating=='more than half the days'] <- 0.66
p2d$Poor_appetite_or_overeating[p2d$Poor_appetite_or_overeating=='several days'] <- 0.33
p2d$Feeling_bad_about_yourself[p2d$Feeling_bad_about_yourself=='nearly every day'] <- 1.00
p2d$Feeling_bad_about_yourself[p2d$Feeling_bad_about_yourself=='more than half the days'] <- 0.66
p2d$Feeling_bad_about_yourself[p2d$Feeling_bad_about_yourself=='several days'] <- 0.33
p2d$Trouble_concentrating_on_things[p2d$Trouble_concentrating_on_things=='nearly every day'] <- 1.00
p2d$Trouble_concentrating_on_things[p2d$Trouble_concentrating_on_things=='more than half the days'] <- 0.66
p2d$Trouble_concentrating_on_things[p2d$Trouble_concentrating_on_things=='several days'] <- 0.33
nr[,colnames(nr) %in% p2] <- p2d
nr <- drop_col(nr,c('ciqd008','ciqd001','ciqd025','ciqd022'))
# * p3 ------------------------------------------------------------
p3 <- c('arthritis','thyroid','chronic_bronchitis','cancer',
'Congestive_heart_failure','Coronary_heart_disease',
'angina','heart_attack','stroke','high_blood_pressure',
'diabetes','weak_kidneys','urinary_leakage')
p3d <- nr[,p3]
p3d[p3d=='no'] <- 0
p3d[p3d=="not at all"] <- 0
p3d[p3d=='borderline'] <- 0.5
p3d[p3d=='yes'] <- 1
p3d$urinary_leakage[p3d$urinary_leakage=='greatly'] = '1.00'
p3d$urinary_leakage[p3d$urinary_leakage=='very much'] = '0.75'
p3d$urinary_leakage[p3d$urinary_leakage=='somewhat'] ='0.50'
p3d$urinary_leakage[p3d$urinary_leakage=='only a little'] = '0.25'
nr[,p3] <- p3d
# * p4 ------------------------------------------------------------
p4 <- c('general_health_condition',
'health_compared_1_year_ago',
'overnight_hospital_patient',
'times_receive_healthcare_over_past_year',
'prescribed_medications')
p4d <- nr[,p4]
p4d$general_health_condition <- ifelse(p4d$general_health_condition %in% c('excellent','very good','good'),0,1)
p4d$health_compared_1_year_ago <- ifelse(p4d$health_compared_1_year_ago %in% 'worse, or',1,0)
p4d$overnight_hospital_patient <- ifelse(p4d$overnight_hospital_patient == 'yes',1,0)
p4d$times_receive_healthcare_over_past_year |> do::unique_no.NA() |> do::increase()
p4d$times_receive_healthcare_over_past_year[p4d$times_receive_healthcare_over_past_year=='none'] <- 0
p4d$times_receive_healthcare_over_past_year <- p4d$times_receive_healthcare_over_past_year |> do::Replace0(' {0,}[a-z].*') |> as.numeric()
p4d$times_receive_healthcare_over_past_year <- ifelse(p4d$times_receive_healthcare_over_past_year == 0,0,
ifelse(p4d$times_receive_healthcare_over_past_year<=4 & p4d$times_receive_healthcare_over_past_year,0.5,1))
p4d$prescribed_medications <- ifelse(p4d$prescribed_medications>=5,1,0.5)
p4d$prescribed_medications[is.na(p4d$prescribed_medications)] <- 0
nr[,p4] <- p4d
# * p5 ------------------------------------------------------------
nr$bmxbmi <- ifelse(nr$bmxbmi <18.5 & nr$bmxbmi >=30,1,
ifelse(nr$bmxbmi >=25 & nr$bmxbmi <30,0.5,0))
# hg <- rowSums(nr[,c('mgxh1t1','mgxh1t2','mgxh1t3','mgxh2t1','mgxh2t2','mgxh2t3')],na.rm = TRUE)
# hgf <- (1:nrow(nr))[hg>0]
# nr$grip_force[hgf] <- sapply(hgf,function(i) max(nr[i,c('mgxh1t1','mgxh1t2','mgxh1t3','mgxh2t1','mgxh2t2','mgxh2t3')],na.rm = TRUE))
# nr$grip_force[hg==0 | is.na(nr$bmxbmi) | is.na(nr$sex)] <- NA # not test grip force
#
# ck1 <- (nr$sex=='male' & nr$bmxbmi <= 24 & nr$grip_force <= 29) |
# (nr$sex=='male' & nr$bmxbmi > 24 & nr$bmxbmi <= 28 & nr$grip_force <= 30) |
# (nr$sex=='male' & nr$bmxbmi > 28 & nr$grip_force <= 32) |
#
# (nr$sex=='female' & nr$bmxbmi <= 23 & nr$grip_force <= 17) |
# (nr$sex=='female' & nr$bmxbmi > 23 & nr$bmxbmi <= 26 & nr$grip_force <= 17.3) |
# (nr$sex=='female' & nr$bmxbmi > 26 & nr$bmxbmi <= 29 & nr$grip_force <= 18) |
# (nr$sex=='female' & nr$bmxbmi > 29 & nr$grip_force <= 21)
#
# nr$grip_force[ck1] <- 1
# nr$grip_force[!ck1] <- 0
# * p6 ------------------------------------------------------------
nr$glycohemoglobin <- ifelse(nr$glycohemoglobin>5.7,1,0)
# 45
ck0 <- (nr$sex=='male' & nr$rbc >= 4.7 & nr$rbc < 6.1) |
(nr$sex=='female' & nr$rbc >= 4.2 & nr$rbc < 5.4)
nr$rbc <- ifelse(ck0,0,1)
# 46
ck0 <- (nr$sex == 'male' & nr$Hemoglobin >= 13.5 & nr$Hemoglobin < 18) |
(nr$sex == 'female' & nr$Hemoglobin >= 12 & nr$Hemoglobin < 16)
nr$Hemoglobin <- ifelse(ck0,0,1)
# 47
nr$Red_cell_distribution_width <- ifelse(nr$Red_cell_distribution_width >= 11.6 & nr$Red_cell_distribution_width < 14.6,0,1)
# 48
nr$Lymphocyte_percent <- ifelse(nr$Lymphocyte_percent >= 20 & nr$Lymphocyte_percent < 40,0,1)
# 49
nr$segmented_neutrophils_percent <- ifelse(nr$segmented_neutrophils_percent >= 40 & nr$segmented_neutrophils_percent < 80,0,1)
# * score ------------------------------------------------------------
nr <- drop_col(nr,'sex','rxddrgid')
for (i in 3:ncol(nr)) {
x <- tryCatch(as.numeric(nr[,i]),warning=function(w) 'e')
if (x[!is.na(x)][1]=='e') stop()
nr[,i] <- x
}
p7 <- c("Experience_confusion_memory_problems", "money_manage", "walking_for_a_quarter_mile",
"walking_up_ten_steps", "stoop_crouch_kneel", "lifting_carry",
"house_chore", "preparing_meals", "walking_between_rooms_on_same_floor",
"standingup_from_armless_chair", "getting_in_and_out_of_bed",
"using_fork_knife_drinking", "dressing_yourself", "standing_for_long_periods",
"sitting_for_long_periods_difficulty", "reaching_up_over_head_difficulty",
"grasp_holding_small_objects", "going_out_to_movies_events_difficulty",
"attending_social_event", "leisure_activity_at_home_difficulty",
"little_interest_in_doing_things", "feeling_down_depressed_or_hopeless",
"Trouble_sleeping_or_sleeping_too_much", "Poor_appetite_or_overeating",
"Feeling_bad_about_yourself", "Trouble_concentrating_on_things",
"arthritis", "thyroid", "chronic_bronchitis", "cancer", "Congestive_heart_failure",
"Coronary_heart_disease", "angina", "heart_attack", "stroke",
"high_blood_pressure", "diabetes", "weak_kidneys", "urinary_leakage",
"general_health_condition", "health_compared_1_year_ago", "overnight_hospital_patient",
"times_receive_healthcare_over_past_year", "prescribed_medications",
"bmxbmi", "glycohemoglobin", "rbc", "Hemoglobin", "Red_cell_distribution_width",
"Lymphocyte_percent", "segmented_neutrophils_percent", "push_or_pull_large_objects",
"Feeling_tired_or_having_little_energy")
p7d <- nr[,p7]
nr$frailty_number <- rowSums(!is.na(p7d))
nr$frailty_score <- rowSums(p7d,na.rm = TRUE) / nr$frailty_number
if (!component) nr <- drop_col(nr,p7)
if (missing(data)){
data <- nr
}else{
data0 <- nr[,!colnames(nr) %in% 'Year']
data <- dplyr::left_join(data,data0,'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.