Mental distress is a key indicator of mental health in the aging population. The dataset used in this project, “Alzheimer’s Disease and Healthy Aging,” was published by the U.S. Centers for Disease Control and Prevention (CDC), covering data from 2015 to 2022. It captures various health indicators stratified by demographic (e.g., age, gender, race/ethnicity) and geographic (state-level) factors.
This project aims to examine the disparities in frequent mental distress among older adults and develop both regression and classification models to support public health decision-making.
1.To analyze the impact of demographic and geographic factors on the level of frequent mental distress among older adults. 2.To build a regression model to predict the percentage of older adults experiencing frequent mental distress. 3.To build a classification model to categorize population subgroups into risk levels: Low (<10%), Moderate (10–20%), and High (>20%).
Alzheimer’s Disease and Healthy Aging Data
The dataset includes data collected from 2015 to 2022.
The dataset is provided by the U.S. Centers for Disease Control and Prevention (CDC) to support public health research, particularly focusing on Alzheimer’s disease, healthy aging, and mental health in older populations. It enables analysis of disparities by demographic and geographic dimensions.
Each record reflects a public health indicator for a specific demographic subgroup (e.g., age + gender + race) in a U.S. state. Key information includes:
YearStart, YearEndLocationDesc, GeolocationClass, Topic,
Question, Data_ValueStratification1,
Stratification2The data is in long format: each row is an observation for a unique combination of factors (e.g., one group in one year in one state).
The dataset is highly structured and supports regression and classification modeling for public health applications. Its extensive time span and geographic coverage enable robust analysis of trends and disparities in mental distress among older adults.
Regression: How do demographic (age group, gender, race/ethnicity) and geographic (state) factors influence the percentage of older adults experiencing frequent mental distress?
Data_ValueStratification1,
Stratification2, LocationAbbr,
YearStartClassification: Based on demographic and location data, can we classify population subgroups into mental distress risk levels (Low, Moderate, High)?
Label Creation:
df$RiskLevel <- cut(df$Data_Value,
breaks = c(-Inf, 10, 20, Inf),
labels = c("Low", "Moderate", "High"))Features: Stratification1,
Stratification2, LocationAbbr,
YearStart
We performed several data preprocessing and cleaning steps to ensure the dataset was suitable for modeling and analysis:
Alzheimer disease and healthy aging data_cleaned.csvdf <- read.csv("Alzheimer disease and healthy aging data.csv")
str(df)## 'data.frame': 284142 obs. of 31 variables:
## $ RowId : chr "BRFSS~2022~2022~42~Q03~TMC01~AGE~RACE" "BRFSS~2022~2022~46~Q03~TMC01~AGE~RACE" "BRFSS~2022~2022~16~Q03~TMC01~AGE~RACE" "BRFSS~2022~2022~24~Q03~TMC01~AGE~RACE" ...
## $ YearStart : int 2022 2022 2022 2022 2022 2022 2022 2022 2022 2022 ...
## $ YearEnd : int 2022 2022 2022 2022 2022 2022 2022 2022 2022 2022 ...
## $ LocationAbbr : chr "PA" "SD" "ID" "MD" ...
## $ LocationDesc : chr "Pennsylvania" "South Dakota" "Idaho" "Maryland" ...
## $ Datasource : chr "BRFSS" "BRFSS" "BRFSS" "BRFSS" ...
## $ Class : chr "Mental Health" "Mental Health" "Mental Health" "Mental Health" ...
## $ Topic : chr "Frequent mental distress" "Frequent mental distress" "Frequent mental distress" "Frequent mental distress" ...
## $ Question : chr "Percentage of older adults who are experiencing frequent mental distress" "Percentage of older adults who are experiencing frequent mental distress" "Percentage of older adults who are experiencing frequent mental distress" "Percentage of older adults who are experiencing frequent mental distress" ...
## $ Data_Value_Unit : chr "%" "%" "%" "%" ...
## $ DataValueTypeID : chr "PRCTG" "PRCTG" "PRCTG" "PRCTG" ...
## $ Data_Value_Type : chr "Percentage" "Percentage" "Percentage" "Percentage" ...
## $ Data_Value : num NA NA NA 9 5.6 NA 21.5 10 39.9 61.9 ...
## $ Data_Value_Alt : num NA NA NA 9 5.6 NA 21.5 10 39.9 61.9 ...
## $ Data_Value_Footnote_Symbol: chr "~" "~" "~" "" ...
## $ Data_Value_Footnote : chr "No Data Available" "No Data Available" "No Data Available" "" ...
## $ Low_Confidence_Limit : num NA NA NA 6.5 4.4 NA 15.4 8.3 35.6 45.9 ...
## $ High_Confidence_Limit : num NA NA NA 12.3 7.2 NA 29.2 12.1 44.4 75.6 ...
## $ StratificationCategory1 : chr "Age Group" "Age Group" "Age Group" "Age Group" ...
## $ Stratification1 : chr "50-64 years" "65 years or older" "65 years or older" "65 years or older" ...
## $ StratificationCategory2 : chr "Race/Ethnicity" "Race/Ethnicity" "Race/Ethnicity" "Race/Ethnicity" ...
## $ Stratification2 : chr "Native Am/Alaskan Native" "Asian/Pacific Islander" "Black, non-Hispanic" "Black, non-Hispanic" ...
## $ Geolocation : chr "POINT (-77.86070029 40.79373015)" "POINT (-100.3735306 44.35313005)" "POINT (-114.36373 43.68263001)" "POINT (-76.60926011 39.29058096)" ...
## $ ClassID : chr "C05" "C05" "C05" "C05" ...
## $ TopicID : chr "TMC01" "TMC01" "TMC01" "TMC01" ...
## $ QuestionID : chr "Q03" "Q03" "Q03" "Q03" ...
## $ LocationID : int 42 46 16 24 55 19 40 42 42 5 ...
## $ StratificationCategoryID1 : chr "AGE" "AGE" "AGE" "AGE" ...
## $ StratificationID1 : chr "5064" "65PLUS" "65PLUS" "65PLUS" ...
## $ StratificationCategoryID2 : chr "RACE" "RACE" "RACE" "RACE" ...
## $ StratificationID2 : chr "NAA" "ASN" "BLK" "BLK" ...summary(df)## RowId YearStart YearEnd LocationAbbr
## Length:284142 Min. :2015 Min. :2015 Length:284142
## Class :character 1st Qu.:2017 1st Qu.:2017 Class :character
## Mode :character Median :2019 Median :2019 Mode :character
## Mean :2019 Mean :2019
## 3rd Qu.:2021 3rd Qu.:2021
## Max. :2022 Max. :2022
##
## LocationDesc Datasource Class Topic
## Length:284142 Length:284142 Length:284142 Length:284142
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Question Data_Value_Unit DataValueTypeID Data_Value_Type
## Length:284142 Length:284142 Length:284142 Length:284142
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Data_Value Data_Value_Alt Data_Value_Footnote_Symbol
## Min. : 0.00 Min. : 0.00 Length:284142
## 1st Qu.: 15.90 1st Qu.: 15.90 Class :character
## Median : 32.80 Median : 32.80 Mode :character
## Mean : 37.68 Mean : 37.68
## 3rd Qu.: 56.90 3rd Qu.: 56.90
## Max. :100.00 Max. :100.00
## NA's :91334 NA's :91334
## Data_Value_Footnote Low_Confidence_Limit High_Confidence_Limit
## Length:284142 Min. :-0.70 Min. : 1.3
## Class :character 1st Qu.:12.60 1st Qu.: 19.7
## Mode :character Median :27.00 Median : 38.9
## Mean :33.03 Mean : 42.6
## 3rd Qu.:49.40 3rd Qu.: 64.6
## Max. :99.60 Max. :100.0
## NA's :91545 NA's :91545
## StratificationCategory1 Stratification1 StratificationCategory2
## Length:284142 Length:284142 Length:284142
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## Stratification2 Geolocation ClassID TopicID
## Length:284142 Length:284142 Length:284142 Length:284142
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## QuestionID LocationID StratificationCategoryID1
## Length:284142 Min. : 1.0 Length:284142
## Class :character 1st Qu.: 19.0 Class :character
## Mode :character Median : 34.0 Mode :character
## Mean : 800.3
## 3rd Qu.: 49.0
## Max. :9004.0
##
## StratificationID1 StratificationCategoryID2 StratificationID2
## Length:284142 Length:284142 Length:284142
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## head(df)## RowId YearStart YearEnd LocationAbbr
## 1 BRFSS~2022~2022~42~Q03~TMC01~AGE~RACE 2022 2022 PA
## 2 BRFSS~2022~2022~46~Q03~TMC01~AGE~RACE 2022 2022 SD
## 3 BRFSS~2022~2022~16~Q03~TMC01~AGE~RACE 2022 2022 ID
## 4 BRFSS~2022~2022~24~Q03~TMC01~AGE~RACE 2022 2022 MD
## 5 BRFSS~2022~2022~55~Q03~TMC01~AGE~GENDER 2022 2022 WI
## 6 BRFSS~2022~2022~19~Q03~TMC01~AGE~RACE 2022 2022 IA
## LocationDesc Datasource Class Topic
## 1 Pennsylvania BRFSS Mental Health Frequent mental distress
## 2 South Dakota BRFSS Mental Health Frequent mental distress
## 3 Idaho BRFSS Mental Health Frequent mental distress
## 4 Maryland BRFSS Mental Health Frequent mental distress
## 5 Wisconsin BRFSS Mental Health Frequent mental distress
## 6 Iowa BRFSS Mental Health Frequent mental distress
## Question
## 1 Percentage of older adults who are experiencing frequent mental distress
## 2 Percentage of older adults who are experiencing frequent mental distress
## 3 Percentage of older adults who are experiencing frequent mental distress
## 4 Percentage of older adults who are experiencing frequent mental distress
## 5 Percentage of older adults who are experiencing frequent mental distress
## 6 Percentage of older adults who are experiencing frequent mental distress
## Data_Value_Unit DataValueTypeID Data_Value_Type Data_Value Data_Value_Alt
## 1 % PRCTG Percentage NA NA
## 2 % PRCTG Percentage NA NA
## 3 % PRCTG Percentage NA NA
## 4 % PRCTG Percentage 9.0 9.0
## 5 % PRCTG Percentage 5.6 5.6
## 6 % PRCTG Percentage NA NA
## Data_Value_Footnote_Symbol Data_Value_Footnote Low_Confidence_Limit
## 1 ~ No Data Available NA
## 2 ~ No Data Available NA
## 3 ~ No Data Available NA
## 4 6.5
## 5 4.4
## 6 ~ No Data Available NA
## High_Confidence_Limit StratificationCategory1 Stratification1
## 1 NA Age Group 50-64 years
## 2 NA Age Group 65 years or older
## 3 NA Age Group 65 years or older
## 4 12.3 Age Group 65 years or older
## 5 7.2 Age Group 65 years or older
## 6 NA Age Group Overall
## StratificationCategory2 Stratification2
## 1 Race/Ethnicity Native Am/Alaskan Native
## 2 Race/Ethnicity Asian/Pacific Islander
## 3 Race/Ethnicity Black, non-Hispanic
## 4 Race/Ethnicity Black, non-Hispanic
## 5 Gender Male
## 6 Race/Ethnicity Asian/Pacific Islander
## Geolocation ClassID TopicID QuestionID LocationID
## 1 POINT (-77.86070029 40.79373015) C05 TMC01 Q03 42
## 2 POINT (-100.3735306 44.35313005) C05 TMC01 Q03 46
## 3 POINT (-114.36373 43.68263001) C05 TMC01 Q03 16
## 4 POINT (-76.60926011 39.29058096) C05 TMC01 Q03 24
## 5 POINT (-89.81637074 44.39319117) C05 TMC01 Q03 55
## 6 POINT (-93.81649056 42.46940091) C05 TMC01 Q03 19
## StratificationCategoryID1 StratificationID1 StratificationCategoryID2
## 1 AGE 5064 RACE
## 2 AGE 65PLUS RACE
## 3 AGE 65PLUS RACE
## 4 AGE 65PLUS RACE
## 5 AGE 65PLUS GENDER
## 6 AGE AGE_OVERALL RACE
## StratificationID2
## 1 NAA
## 2 ASN
## 3 BLK
## 4 BLK
## 5 MALE
## 6 ASNduplicate_rows <- df[duplicated(df), ]
cat("Number of duplicate rows:", nrow(duplicate_rows), "\n")## Number of duplicate rows: 0df <- df[!duplicated(df), ]# 3. Delete rows with missing values in the Data_Value column or Topic column
df <- df[!is.na(df$Data_Value) | is.na(df$Topic), ]
# Verify by looking at the number of rows in the data frame before and after cleaning
cat("Number of rows in the original data frame: ", nrow(df), "\n")## Number of rows in the original data frame: 192808cat("Number of data frame rows after removing missing values: ", nrow(df), "\n")## Number of data frame rows after removing missing values: 192808head(df)## RowId YearStart YearEnd LocationAbbr
## 4 BRFSS~2022~2022~24~Q03~TMC01~AGE~RACE 2022 2022 MD
## 5 BRFSS~2022~2022~55~Q03~TMC01~AGE~GENDER 2022 2022 WI
## 7 BRFSS~2022~2022~40~Q03~TMC01~AGE~RACE 2022 2022 OK
## 8 BRFSS~2022~2022~42~Q03~TMC01~AGE~RACE 2022 2022 PA
## 9 BRFSS~2022~2022~42~Q46~TOC10~AGE~GENDER 2022 2022 PA
## 10 BRFSS~2022~2022~05~Q46~TOC10~AGE~RACE 2022 2022 AR
## LocationDesc Datasource Class
## 4 Maryland BRFSS Mental Health
## 5 Wisconsin BRFSS Mental Health
## 7 Oklahoma BRFSS Mental Health
## 8 Pennsylvania BRFSS Mental Health
## 9 Pennsylvania BRFSS Overall Health
## 10 Arkansas BRFSS Overall Health
## Topic
## 4 Frequent mental distress
## 5 Frequent mental distress
## 7 Frequent mental distress
## 8 Frequent mental distress
## 9 Disability status, including sensory or mobility limitations
## 10 Disability status, including sensory or mobility limitations
## Question
## 4 Percentage of older adults who are experiencing frequent mental distress
## 5 Percentage of older adults who are experiencing frequent mental distress
## 7 Percentage of older adults who are experiencing frequent mental distress
## 8 Percentage of older adults who are experiencing frequent mental distress
## 9 Percentage of older adults who report having a disability (includes limitations related to sensory or mobility impairments or a physical, mental, or emotional condition)
## 10 Percentage of older adults who report having a disability (includes limitations related to sensory or mobility impairments or a physical, mental, or emotional condition)
## Data_Value_Unit DataValueTypeID Data_Value_Type Data_Value Data_Value_Alt
## 4 % PRCTG Percentage 9.0 9.0
## 5 % PRCTG Percentage 5.6 5.6
## 7 % PRCTG Percentage 21.5 21.5
## 8 % PRCTG Percentage 10.0 10.0
## 9 % PRCTG Percentage 39.9 39.9
## 10 % PRCTG Percentage 61.9 61.9
## Data_Value_Footnote_Symbol Data_Value_Footnote Low_Confidence_Limit
## 4 6.5
## 5 4.4
## 7 15.4
## 8 8.3
## 9 35.6
## 10 45.9
## High_Confidence_Limit StratificationCategory1 Stratification1
## 4 12.3 Age Group 65 years or older
## 5 7.2 Age Group 65 years or older
## 7 29.2 Age Group Overall
## 8 12.1 Age Group Overall
## 9 44.4 Age Group Overall
## 10 75.6 Age Group Overall
## StratificationCategory2 Stratification2
## 4 Race/Ethnicity Black, non-Hispanic
## 5 Gender Male
## 7 Race/Ethnicity Native Am/Alaskan Native
## 8 Race/Ethnicity White, non-Hispanic
## 9 Gender Female
## 10 Race/Ethnicity Native Am/Alaskan Native
## Geolocation ClassID TopicID QuestionID LocationID
## 4 POINT (-76.60926011 39.29058096) C05 TMC01 Q03 24
## 5 POINT (-89.81637074 44.39319117) C05 TMC01 Q03 55
## 7 POINT (-97.52107021 35.47203136) C05 TMC01 Q03 40
## 8 POINT (-77.86070029 40.79373015) C05 TMC01 Q03 42
## 9 POINT (-77.86070029 40.79373015) C01 TOC10 Q46 42
## 10 POINT (-92.27449074 34.74865012) C01 TOC10 Q46 5
## StratificationCategoryID1 StratificationID1 StratificationCategoryID2
## 4 AGE 65PLUS RACE
## 5 AGE 65PLUS GENDER
## 7 AGE AGE_OVERALL RACE
## 8 AGE AGE_OVERALL RACE
## 9 AGE AGE_OVERALL GENDER
## 10 AGE AGE_OVERALL RACE
## StratificationID2
## 4 BLK
## 5 MALE
## 7 NAA
## 8 WHT
## 9 FEMALE
## 10 NAA# The number of missing values before filling
cat("--- Number of missing values before filling ---\n")## --- Number of missing values before filling ---print(sapply(df, function(x) sum(is.na(x))))## RowId YearStart
## 0 0
## YearEnd LocationAbbr
## 0 0
## LocationDesc Datasource
## 0 0
## Class Topic
## 0 0
## Question Data_Value_Unit
## 0 0
## DataValueTypeID Data_Value_Type
## 0 0
## Data_Value Data_Value_Alt
## 0 0
## Data_Value_Footnote_Symbol Data_Value_Footnote
## 0 0
## Low_Confidence_Limit High_Confidence_Limit
## 211 211
## StratificationCategory1 Stratification1
## 0 0
## StratificationCategory2 Stratification2
## 0 0
## Geolocation ClassID
## 0 0
## TopicID QuestionID
## 0 0
## LocationID StratificationCategoryID1
## 0 0
## StratificationID1 StratificationCategoryID2
## 0 0
## StratificationID2
## 0# Missing value filling
df_filled <- df %>%
mutate(
# Processing numeric columns: Replace with median
across(where(is.numeric), ~ ifelse(is.na(.), median(., na.rm = TRUE), .)),
# Handling non-numeric columns: Replace with 'unknown'
across(where(~ !is.numeric(.)), ~ ifelse(is.na(.), 'unknown', as.character(.)))
)
# The number of missing values after filling
cat("\n--- Number of missing values after filling ---\n")##
## --- Number of missing values after filling ---print(sapply(df_filled, function(x) sum(is.na(x))))## RowId YearStart
## 0 0
## YearEnd LocationAbbr
## 0 0
## LocationDesc Datasource
## 0 0
## Class Topic
## 0 0
## Question Data_Value_Unit
## 0 0
## DataValueTypeID Data_Value_Type
## 0 0
## Data_Value Data_Value_Alt
## 0 0
## Data_Value_Footnote_Symbol Data_Value_Footnote
## 0 0
## Low_Confidence_Limit High_Confidence_Limit
## 0 0
## StratificationCategory1 Stratification1
## 0 0
## StratificationCategory2 Stratification2
## 0 0
## Geolocation ClassID
## 0 0
## TopicID QuestionID
## 0 0
## LocationID StratificationCategoryID1
## 0 0
## StratificationID1 StratificationCategoryID2
## 0 0
## StratificationID2
## 0# Reserved Stratification1 values
allowed_stratification_values <- c("65 years or older", "Overall", "50-64 years")
# Filter data
df_temp <- df %>%
filter(Stratification1 %in% allowed_stratification_values)
# Check the number of rows before and after the deletion
cat("The number of rows(before processing):", nrow(df), "\n")## The number of rows(before processing): 192808cat("The number of rows(after processing):", nrow(df_temp), "\n")## The number of rows(after processing): 192808# check tratification1
cat("Value of Stratification1 after removing outliers:\n")## Value of Stratification1 after removing outliers:print(unique(df_temp$Stratification1))## [1] "65 years or older" "Overall" "50-64 years"df <- df_temp# Create a new column to determine whether Data_Value is within the confidence interval
df$Is_Within_Confidence_Interval <-
df$Data_Value >= df$Low_Confidence_Limit &
df$Data_Value <= df$High_Confidence_Limit
# Convert boolean values to factors so ggplot2 can differentiate them with colors
df$Is_Within_Confidence_Interval <-
factor(df$Is_Within_Confidence_Interval,
levels = c(FALSE, TRUE),
labels = c("Outside CI", "Within CI"))
# Generate a scatter plot
ggplot(df, aes(x = 1:nrow(df), y = Data_Value, color = Is_Within_Confidence_Interval)) +
geom_point(alpha = 0.6) + # alpha controls the transparency of the point
scale_color_manual(values = c("Outside CI" = "red", "Within CI" = "blue")) +
labs(title = "Data_Value Points with Confidence Interval Status",
x = "Record Index",
y = "Data Value",
color = "Status") +
theme_minimal()
df_long <- melt(df[, c("Data_Value", "Data_Value_Alt", "Low_Confidence_Limit", "High_Confidence_Limit")])## No id variables; using all as measure variablesggplot(df_long, aes(x = variable, y = value)) +
geom_boxplot(fill = "lightblue") +
labs(title = "Boxplot of Key Value Columns", x = "", y = "Value") +
theme_minimal()## Warning: Removed 422 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
# Define mappings
old_values_disability <- 'Percentage of older adults who report having a disability (includes limitations related to sensory or mobility impairments or a physical, mental, or emotional condition)'
old_values_pneu_vaccine <- 'Percentage of at risk adults (have diabetes, asthma, cardiovascular disease or currently smoke) who ever had a pneumococcal vaccine'
old_values_obesity <- 'Percentage of older adults who are currently obese, with a body mass index (BMI) of 30 or more'
old_values_clinical <- c(
'Percentage of older adult men who are up to date with select clinical preventive services',
'Percentage of older adult women who are up to date with select clinical preventive services'
)
old_values_provide <- c(
'Percentage of older adults who provided care for a friend or family member within the past month',
'Percentage of older adults who provided care to a friend or family member for six months or more',
'Average of 20 or more hours of care per week provided to a friend or family member',
'Percentage of older adults who provided care for someone with dementia or other cognitive impairment within the past month',
'Percentage of older adults currently not providing care who expect to provide care for someone with health problems in the next two years'
)
old_values_hypertension <- c(
'Percentage of older adults who have been told they have high blood pressure who report currently taking medication for their high blood pressure',
'Percentage of older adults who have ever been told by a health professional that they have high blood pressure'
)
old_values_smoked <- 'Percentage of older adults who have smoked at least 100 cigarettes in their entire life and still smoke every day or some days'
old_values_less <- c(
'Percentage of older adults who reported subjective cognitive decline or memory loss that interferes with their ability to engage in social activities or household chores',
'Percentage of older adults with subjective cognitive decline or memory loss who reported talking with a health care professional about it'
)
old_values_more <- c(
'Percentage of older adults who reported subjective cognitive decline or memory loss that is happening more often or is getting worse in the preceding 12 months',
'Percentage of older adults who reported that as a result of subjective cognitive decline or memory loss that they need assistance with day-to-day activities'
)
old_values_colorectal <- 'Percentage of older adults who had either a home blood stool test within the past year or a sigmoidoscopy or colonoscopy within the past 10 years'
# Apply replacements
df$Question <- ifelse(df$Question == old_values_disability, 'disability', df$Question)
df$Question <- ifelse(df$Question == old_values_smoked, 'smoking', df$Question)
df$Question <- ifelse(df$Question == old_values_pneu_vaccine, 'pneumonia vaccination among high-risk groups', df$Question)
df$Question <- ifelse(df$Question == old_values_obesity, 'obesity', df$Question)
df$Question <- ifelse(df$Question %in% old_values_clinical, 'Received clinical preventive services', df$Question)
df$Question <- ifelse(df$Question %in% old_values_provide, 'Provided or will provide care', df$Question)
df$Question <- ifelse(df$Question %in% old_values_hypertension, 'hypertension', df$Question)
df$Question <- ifelse(df$Question %in% old_values_less, 'less cognitive decline', df$Question)
df$Question <- ifelse(df$Question %in% old_values_more, 'more cognitive decline', df$Question)
df$Question <- ifelse(df$Question %in% old_values_colorectal, 'Colorectal related tests', df$Question)#write.csv(df, "D:/Rdata/aging2.csv", row.names = FALSE)# Data preprocessing
df_processed <- df %>%
mutate(
Time_Year = as.numeric(YearStart),
Topic_Factor = as.factor(Question),
AgeGroup_Factor = as.factor(Stratification1) #
) %>%
drop_na(Time_Year, Topic_Factor, AgeGroup_Factor, Data_Value) # # View Question
print(unique(df_processed$Question))## [1] "Percentage of older adults who are experiencing frequent mental distress"
## [2] "disability"
## [3] "Percentage of older adults who report having lost 5 or fewer teeth due to decay or gum disease"
## [4] "pneumonia vaccination among high-risk groups"
## [5] "Received clinical preventive services"
## [6] "Percentage of older adult women who have received a mammogram within the past 2 years"
## [7] "Percentage of older adult women with an intact cervix who had a Pap test within the past 3 years"
## [8] "obesity"
## [9] "Colorectal related tests"
## [10] "Percentage of older adults who have not had any leisure time physical activity in the past month"
## [11] "smoking"
## [12] "Percentage of older adults who reported influenza vaccine within the past year"
## [13] "Percentage of older adults without diabetes who reported a blood sugar or diabetes test within 3 years"
## [14] "Percentage of older adults who reported binge drinking within the past 30 days"
## [15] "Percentage of older adults with a lifetime diagnosis of depression"
## [16] "less cognitive decline"
## [17] "Percentage of older adults who self-reported that their health is \"fair\" or \"poor\""
## [18] "Percentage of older adults who self-reported that their health is \"good\", \"very good\", or \"excellent\""
## [19] "Percentage of older adults getting sufficient sleep (>6 hours)"
## [20] "Mean number of days with activity limitations in the past month"
## [21] "Provided or will provide care"
## [22] "Percentage of older adults ever told they have arthritis"
## [23] "Fair or poor health among older adults with doctor-diagnosed arthritis"
## [24] "more cognitive decline"
## [25] "Percentage of older adults who are eating 2 or more fruits daily"
## [26] "Percentage of older adults who are eating 3 or more vegetables daily"
## [27] "hypertension"
## [28] "Physically unhealthy days (mean number of days in past month)"
## [29] "Percentage of older adults who had a cholesterol screening within the past 5 years"
## [30] "Severe joint pain due to arthritis among older adults with doctor-diagnosed arthritis"
## [31] "Percentage of older adults who have fallen and sustained an injury within last year"# View YearStart
print(unique(df_processed$YearStart))## [1] 2022 2021 2019 2020 2018 2015 2017 2016# View Stratification1
print(unique(df_processed$Stratification1))## [1] "65 years or older" "Overall" "50-64 years"library(knitr)
question_distribution <- df %>%
count(Question, name = "Count")
kable(question_distribution)| Question | Count |
|---|---|
| Colorectal related tests | 4023 |
| Fair or poor health among older adults with doctor-diagnosed arthritis | 5365 |
| Mean number of days with activity limitations in the past month | 7336 |
| Percentage of older adult women who have received a mammogram within the past 2 years | 2541 |
| Percentage of older adult women with an intact cervix who had a Pap test within the past 3 years | 2340 |
| Percentage of older adults ever told they have arthritis | 6053 |
| Percentage of older adults getting sufficient sleep (>6 hours) | 4131 |
| Percentage of older adults who are eating 2 or more fruits daily | 3893 |
| Percentage of older adults who are eating 3 or more vegetables daily | 3532 |
| Percentage of older adults who are experiencing frequent mental distress | 7072 |
| Percentage of older adults who had a cholesterol screening within the past 5 years | 4033 |
| Percentage of older adults who have fallen and sustained an injury within last year | 2587 |
| Percentage of older adults who have not had any leisure time physical activity in the past month | 7997 |
| Percentage of older adults who report having lost 5 or fewer teeth due to decay or gum disease | 4124 |
| Percentage of older adults who reported binge drinking within the past 30 days | 6640 |
| Percentage of older adults who reported influenza vaccine within the past year | 8062 |
| Percentage of older adults who self-reported that their health is “fair” or “poor” | 7944 |
| Percentage of older adults who self-reported that their health is “good”, “very good”, or “excellent” | 8200 |
| Percentage of older adults with a lifetime diagnosis of depression | 7436 |
| Percentage of older adults without diabetes who reported a blood sugar or diabetes test within 3 years | 4378 |
| Physically unhealthy days (mean number of days in past month) | 7837 |
| Provided or will provide care | 17248 |
| Received clinical preventive services | 4802 |
| Severe joint pain due to arthritis among older adults with doctor-diagnosed arthritis | 3522 |
| disability | 7058 |
| hypertension | 7784 |
| less cognitive decline | 6861 |
| more cognitive decline | 7275 |
| obesity | 7891 |
| pneumonia vaccination among high-risk groups | 7579 |
| smoking | 7264 |
ggplot(question_distribution, aes(x = Question, y = Count)) +
geom_bar(stat = "identity", fill = "lightgreen") +
labs(title = "Distribution of Question Categories",
x = "Question",
y = "Frequency") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
expand_limits(y = max(question_distribution$Count) * 1.2)
ggplot(df, aes(x = Data_Value)) +
geom_histogram(binwidth = 1, fill = "skyblue", color = "black") +
labs(title = "Distribution of Data_Value (Histogram)",
x = "Data Value",
y = "Frequency") +
theme_minimal()
overall_summary_data <- df %>%
group_by(Question, Stratification1) %>%
summarise(
Mean = mean(Data_Value, na.rm = TRUE),
Median = median(Data_Value, na.rm = TRUE),
.groups = 'drop'
) %>%
pivot_longer(cols = c(Mean, Median), names_to = "Statistics", values_to = "Value")
ggplot(overall_summary_data, aes(x = Stratification1, y = Value, fill = Statistics)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.7), width = 0.6) +
facet_wrap(~ Question, scales = "free_y", ncol = 1) +
labs(title = "Mean and Median of Data_Value by Age Group and Question",
x = "Age Group",
y = "Value",
fill = "Statistics") +
theme(axis.text.x = element_text(angle = 60, hjust = 1, vjust = 1),
legend.position = "bottom") +
scale_fill_brewer(palette = "Set2")
# Filter to specific questions
selected_data <- df[df$Question %in% c('less cognitive decline', 'more cognitive decline'), ] %>%
mutate(
YearStart = as.factor(YearStart) # Convert years to factors
)
# Aggregate data
summary_data <- selected_data %>%
group_by(YearStart, Stratification1, Question) %>%
summarise(
median = median(Data_Value, na.rm = TRUE),
mean = mean(Data_Value, na.rm = TRUE),
.groups = 'drop'
)
# melt data
melted_data <- summary_data %>%
pivot_longer(cols = c(median, mean), names_to = "Statistics", values_to = "Value")
# 4. Draw a bar graph
ggplot(melted_data, aes(x = Stratification1, y = Value, fill = interaction(Question, Statistics))) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Mean and Median of Cognitive Decline Indicators by Age Group and Year",
x = "Age Group",
y = "Value",
fill = "Question & Statistic") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
plot.title = element_text(hjust = 0.5, face = "bold")) +
scale_fill_brewer(palette = "Paired") +
facet_wrap(~ YearStart, scales = "free_x", ncol = 4) 
# Specify Question
chosen_topics_values <- c("less cognitive decline", "more cognitive decline")
df_filtered_multi_topic <- df_processed %>%
filter(Topic_Factor %in% chosen_topics_values) # Using %in% to filter multiple values
# Check the number of rows in the filtered data frame to make sure it is not 0
print(paste("Rows after multi-topic filtering:", nrow(df_filtered_multi_topic)))## [1] "Rows after multi-topic filtering: 14136"# Aggregate data
df_aggregated_faceted <- df_filtered_multi_topic %>%
group_by(Time_Year, Topic_Factor, AgeGroup_Factor) %>%
summarise(
Mean_Data_Value = mean(Data_Value, na.rm = TRUE),
.groups = 'drop'
) %>%
arrange(Topic_Factor, AgeGroup_Factor, Time_Year)
# Draw a faceted line chart
ggplot(df_aggregated_faceted, aes(x = Time_Year, y = Mean_Data_Value, color = AgeGroup_Factor, group = AgeGroup_Factor)) +
geom_line(size = 1.2) +
geom_point(size = 3, alpha = 0.8) +
labs(
title = paste0("Data Value Trends by Age Group Over Years for Selected Topics"),
subtitle = paste0("Topics: ", paste(chosen_topics_values, collapse = ", ")),
x = "Year",
y = "Mean Data Value",
color = "Age Group"
) +
# Make sure the X-axis ticks show all relevant years, and display them as integers
scale_x_continuous(breaks = unique(df_aggregated_faceted$Time_Year),
labels = as.character(unique(df_aggregated_faceted$Time_Year))) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
plot.subtitle = element_text(hjust = 0.5, size = 10, color = "gray50"),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
axis.text.x = element_text(angle = 45, hjust = 1, size = 10),
axis.text.y = element_text(size = 10),
legend.position = "right",
panel.grid.minor = element_blank(),
strip.text = element_text(face = "bold")
) +
scale_color_brewer(palette = "Set1") +
facet_wrap(~ Topic_Factor, scales = "free_y", ncol = 2)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# ===== Environment Setup =====
library(tidyverse) # Data processing + visualization## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ lubridate 1.9.4 ✔ stringr 1.5.1
## ✔ purrr 1.0.4 ✔ tibble 3.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(caret) # Machine learning tools## 载入需要的程序包：lattice
##
## 载入程序包：'caret'
##
## The following object is masked from 'package:purrr':
##
## liftlibrary(rpart) # Decision tree model
library(rpart.plot) # Decision tree visualization
library(yardstick) # Evaluation metrics##
## 载入程序包：'yardstick'
##
## The following objects are masked from 'package:caret':
##
## precision, recall, sensitivity, specificity
##
## The following object is masked from 'package:readr':
##
## speclibrary(vip) # Variable importance visualization##
## 载入程序包：'vip'
##
## The following object is masked from 'package:utils':
##
## viif (!require(ggfortify)) {
install.packages("ggfortify")
library(ggfortify)
}## 载入需要的程序包：ggfortify# Set random seed (for reproducibility)
set.seed(123)
# ===== Data Loading and Preprocessing =====
df <- read.csv("aging2.csv", header = TRUE, stringsAsFactors = TRUE)
#df <- read.csv(data_path, header = TRUE, stringsAsFactors = TRUE)
# Data cleaning + Categorical variable processing
df_filtered <- df %>%
filter(Topic == "Frequent mental distress") %>%
drop_na(Data_Value, Stratification1, LocationAbbr, YearStart) %>%
mutate(YearStart = as.factor(YearStart)) %>% # Convert to factor
# Lump rare categories
mutate(
Stratification1 = fct_lump(Stratification1, n = 10),
LocationAbbr = fct_lump(LocationAbbr, n = 10),
YearStart = fct_lump(YearStart, n = 5)
) %>%
# Create risk level
mutate(
RiskLevel = cut(
Data_Value,
breaks = c(-Inf, 10, 20, Inf),
labels = c("Low", "Moderate", "High")
),
across(c(Stratification1, LocationAbbr, YearStart), as.factor)
)
cat("Data preprocessing completed! Remaining sample size: ", nrow(df_filtered), "\n")## Data preprocessing completed! Remaining sample size: 2366# ===== Data Distribution Visualization (Must-See!) =====
# 1. Distribution of mental stress values
p1 <- df_filtered %>%
ggplot(aes(x = Data_Value)) +
geom_histogram(bins = 30, fill = "#007BC2", color = "white") +
labs(title = "Distribution of Mental Stress Values", x = "Mental Stress Value", y = "Number of Samples") +
theme_minimal()
# 2. Distribution of risk levels
p2 <- df_filtered %>%
ggplot(aes(x = RiskLevel, fill = RiskLevel)) +
geom_bar() +
scale_fill_manual(values = c("#66C2A5", "#FC8D62", "#8DA0CB")) +
labs(title = "Distribution of Risk Levels", x = "Risk Level", y = "Number of Samples") +
theme_minimal()
# 3. Distribution of categorical variable (taking LocationAbbr as an example)
p3 <- df_filtered %>%
ggplot(aes(x = fct_rev(fct_infreq(LocationAbbr)))) +
geom_bar(fill = "#E78AC3") +
coord_flip() +
labs(title = "Distribution of LocationAbbr Categories", x = "LocationAbbr", y = "Number of Samples") +
theme_minimal()
# Print visualizations
print("=== Data Distribution Visualization ===")## [1] "=== Data Distribution Visualization ==="print(p1)
print(p2)
print(p3)
# ===== Regression Analysis (with Visualization) =====
# Split the dataset
# Assume df_filtered is the processed data frame, execute before splitting training and test sets
df_filtered <- df_filtered %>%
mutate(YearStart = fct_explicit_na(YearStart, na_level = "Unknown"))## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `YearStart = fct_explicit_na(YearStart, na_level = "Unknown")`.
## Caused by warning:
## ! `fct_explicit_na()` was deprecated in forcats 1.0.0.
## ℹ Please use `fct_na_value_to_level()` instead.trainIndex_reg <- createDataPartition(df_filtered$Data_Value, p = 0.7, list = FALSE)
trainData_reg <- df_filtered[trainIndex_reg, ]
testData_reg <- df_filtered[-trainIndex_reg, ]
# Train linear regression model
lm_model <- lm(Data_Value ~ Stratification1 + LocationAbbr + YearStart, data = trainData_reg)
# Model diagnostic visualization (residual analysis)
p4 <- ggplot(data = data.frame(resid = resid(lm_model)), aes(x = resid)) +
geom_histogram(bins = 30, fill = "#A6D854", color = "white") +
labs(title = "Residual Distribution of Linear Regression", x = "Residual Value", y = "Frequency") +
theme_minimal()
# Variable importance visualization
vip_lm <- vip(lm_model, geom = "col", fill = "#FFD92F") +
labs(title = "Variable Importance of Linear Regression", x = "Variable", y = "Importance") +
theme_minimal()
# Print visualizations
print("\n=== Regression Model Visualization ===")## [1] "\n=== Regression Model Visualization ==="print(p4)
print(vip_lm)
# Model evaluation
lm_pred <- predict(lm_model, testData_reg)
lm_metrics <- postResample(lm_pred, testData_reg$Data_Value)
cat("\n=== Linear Regression Model Evaluation ===\n")##
## === Linear Regression Model Evaluation ===cat("R²: ", round(lm_metrics["Rsquared"], 4), "\n")## R²: 0.0011cat("RMSE: ", round(lm_metrics["RMSE"], 2), "\n")## RMSE: 10.52# ===== Classification Analysis =====
# Split the dataset
trainIndex_cls <- createDataPartition(df_filtered$RiskLevel, p = 0.7, list = FALSE)
trainData_cls <- df_filtered[trainIndex_cls, ]
testData_cls <- df_filtered[-trainIndex_cls, ]
# Train decision tree classification model
dt_model <- rpart(
RiskLevel ~ Stratification1 + LocationAbbr + YearStart,
data = trainData_cls,
method = "class",
cp = 0.01,
minsplit = 100
)
# Decision tree visualization
print("\n=== Decision Tree Visualization ===")## [1] "\n=== Decision Tree Visualization ==="rpart.plot(
dt_model,
type = 4, # Display classification rules
fallen.leaves = TRUE,
box.palette = "GnBu",
branch.lty = 3,
shadow.col = "gray"
)
dt_pred <- predict(dt_model, testData_cls, type = "class")
dt_cm <- confusionMatrix(dt_pred, testData_cls$RiskLevel)
# Replace the original confusion matrix visualization code
library(yardstick)
# Construct tidy format of confusion matrix
dt_cm_tidy <- dt_cm %>%
pluck("table") %>%
as_tibble() %>%
rename(Truth = Reference, Prediction = Prediction)
# Plot heatmap
p5 <- dt_cm_tidy %>%
ggplot(aes(x = Truth, y = Prediction, fill = n)) +
geom_tile() +
geom_text(aes(label = n), color = "white") +
scale_fill_gradient(low = "#E5F5E0", high = "#31A354") +
labs(title = "Decision Tree Confusion Matrix", x = "True Label", y = "Predicted Label") +
theme_minimal()
# Variable importance visualization
vip_dt <- vip(dt_model, geom = "col", fill = "#E5C494") +
labs(title = "Variable Importance of Decision Tree", x = "Variable", y = "Importance") +
theme_minimal()
# Print visualizations
print("\n=== Classification Model Visualization ===")## [1] "\n=== Classification Model Visualization ==="print(p5)
print(vip_dt)
# Model evaluation
cat("\n=== Decision Tree Classification Model Evaluation ===\n")##
## === Decision Tree Classification Model Evaluation ===cat("Accuracy: ", round(dt_cm$overall["Accuracy"], 4), "\n")## Accuracy: 0.4528cat("Kappa: ", round(dt_cm$overall["Kappa"], 4), "\n")## Kappa: 0.1236# ===== End =====
cat("\nAnalysis completed! All visualizations have been generated, check the Plots panel.\n")##
## Analysis completed! All visualizations have been generated, check the Plots panel.The regression model aimed to predict the percentage of older adults experiencing frequent mental distress based on demographic and geographic variables. The model’s R-squared value was 0.0011, meaning it explained only 0.11% of the variance in the target variable. This indicates extremely poor predictive power. The model failed to capture any meaningful relationships, and its predictions were nearly indistinguishable from random guesses. This may be due to the limited informativeness of the input features—age group, location, and year—which do not capture key influencing factors such as psychological well-being, income level, and health status.
The model’s Root Mean Squared Error was 10.52, which is considered high. Given that the actual average rate of mental distress among older adults may be around 15%, an RMSE of 10.52 reflects substantial deviations between predicted and actual values, demonstrating that the model’s numerical predictions are highly inaccurate.
In the classification task, the model attempted to categorize individuals into one of three mental health risk levels: Low, Moderate, or High. The overall accuracy was 45.3%, which is only slightly higher than the random baseline of 33% for a three-class classification problem. Although this suggests the model captured some pattern in the data, the performance remains insufficient for practical use. Additionally, the model showed a tendency to overpredict the “Moderate” category, which may have inflated the accuracy artificially due to class imbalance.
The Kappa statistic was 0.1236, which accounts for agreement occurring by chance. This value is extremely low, indicating poor reliability. A Kappa value above 0.6 is generally considered acceptable for real-world applications; thus, a value of 0.12 suggests that the model barely learned any meaningful differentiation between classes.
The variable importance analysis revealed that age stratification was the most significant predictor in both regression and classification models. Older adults, particularly those aged 65 and above, were more likely to experience moderate or high levels of mental distress. This finding aligns with known patterns of psychological vulnerability associated with aging, such as increased isolation, declining physical health, and reduced social support.
Geographic location also played a notable role, as some states (e.g., Washington, California, Indiana, Nebraska) appeared more frequently as influential predictors. This may reflect state-level disparities in mental health infrastructure, access to care, socioeconomic stressors, or demographic compositions.
In contrast, survey year had minimal importance in both models, suggesting that annual fluctuations in mental distress prevalence were relatively small compared to demographic and regional factors.
Based on the decision tree structure, the subgroup most frequently classified as high risk consisted of individuals aged 65 years and older residing in certain states such as Washington (WA), California (CA), Indiana (IN), and Nebraska (NE). Age stratification appeared at the root node of the tree, indicating that it was the most decisive factor for risk classification.
Older adults in these states may face higher mental distress due to factors such as limited access to mental health care, higher cost of living, social isolation, or demographic vulnerabilities. In contrast, younger adults or those living in other states like Texas or Florida were more often classified into lower risk categories.
This pattern suggests that age combined with geographic location is a critical determinant in identifying high-risk groups for mental health concerns.
Neither of the models fully achieved the intended goals of accurate prediction and risk classification of mental distress among older adults. The regression model performed especially poorly, with an R-squared value close to zero and a high RMSE, indicating that the chosen predictors—age group, location, and year—were insufficient to explain variation in mental distress rates.
The classification model also fell short of expectations. Although the accuracy of 45.3% was slightly better than random guessing in a three-class problem, the Kappa statistic of 0.1236 suggested poor agreement between predicted and actual risk levels. The model displayed a strong bias toward predicting the “Moderate” class, likely due to class imbalance and limited feature informativeness.
These results imply that while the models provide a basic exploratory framework, they are not yet suitable for real-world predictive applications. Future modeling efforts should incorporate richer individual-level data (e.g., income, health status, social support) and experiment with more powerful algorithms to improve performance.
Neither of the models fully achieved the intended goals of accurate prediction and risk classification of mental distress among older adults. The regression model performed especially poorly, with an R-squared value close to zero and a high RMSE, indicating that the chosen predictors—age group, location, and year—were insufficient to explain variation in mental distress rates.
The classification model also fell short of expectations. Although the accuracy of 45.3% was slightly better than random guessing in a three-class problem, the Kappa statistic of 0.1236 suggested poor agreement between predicted and actual risk levels. The model displayed a strong bias toward predicting the “Moderate” class, likely due to class imbalance and limited feature informativeness.
These results imply that while the models provide a basic exploratory framework, they are not yet suitable for real-world predictive applications. Future modeling efforts should incorporate richer individual-level data (e.g., income, health status, social support) and experiment with more powerful algorithms to improve performance.
Several limitations were identified in the current modeling approach. First, the set of predictors was limited to broad demographic and geographic factors—age group, location, and year—which may not fully capture the complex social, psychological, and health-related drivers of mental distress. Important individual-level features such as income, education, physical health, and social support were not included.
Second, the data were aggregated at the group or state level, which may mask within-group variation and introduce ecological bias. The classification model may have been further affected by class imbalance, as the model showed a strong tendency to predict the “Moderate” class regardless of true labels.
Third, the regression model used a simple linear framework, which may not adequately model non-linear interactions. The decision tree classifier, while interpretable, is prone to overfitting and lacks robustness. Moreover, no assessment of multicollinearity was conducted, which may be problematic if structural overlaps exist among variables such as region and age distribution.
Future work should incorporate richer, individual-level datasets, and explore more sophisticated modeling techniques including ensemble methods and regularization to improve performance and interpretability.
The modeling process yielded several key insights despite overall low predictive performance. Both the regression and classification analyses highlighted the importance of age stratification and geographic region in shaping mental distress risk among older adults. Individuals aged 65 and above in certain states were more likely to be classified into higher-risk groups, indicating a potential interaction between aging and regional socioeconomic factors.
However, the models also demonstrated the limitations of using only aggregated demographic and geographic variables. The regression model explained virtually none of the variance in mental distress prevalence, and the classification model showed modest accuracy with a tendency to overpredict the moderate risk category.
Nevertheless, the study provided a useful initial framework for understanding population-level disparities in mental health outcomes and emphasized the need for richer data and more advanced modeling techniques in future work.
For future research and practice, several improvements are essential to enhance predictive accuracy and policy applicability. First, integrating individual-level data such as income, education, physical and mental health status, and access to care could significantly improve model performance. These factors are likely more directly linked to mental distress than the current broad demographic categories.
Second, adopting more sophisticated modeling techniques—including ensemble methods or neural networks—may help capture complex non-linear relationships between predictors and outcomes.
Third, while the current models are not suitable for real-world deployment, the observed associations between age, location, and mental health risk levels offer valuable preliminary insights. These could inform the early identification of vulnerable subgroups and guide targeted mental health interventions at the regional level.
In summary, this work lays a foundation for deeper investigation and provides direction for developing more robust, policy-relevant predictive models in the future.