library(readr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(base)
#library(tigerstats)
library(mosaic)
library(pROC) # for ROC/AUC
library(caret)Untitled
Predicting Incidence of Heart Disease as a Result of Lifestyle Habits
The aim of the project is to create a model from the data set that will reliably predict the incidence of heart disease based off a number of ‘lifestyle habits’. Lifestyle habits are defined as ,for the purpose of the study: smoking, drinking, and the different food consumptions.
#data import and manipulation
cvd <- read_csv("D:/python stuff/CVD_cleaned.csv")
cvd <-as.data.frame(cvd)
cvd <- cvd %>%
rename(
height = `Height_(cm)`,
weight = `Weight_(kg)`,
age = Age_Category,
Fruit = Fruit_Consumption,
Fries = FriedPotato_Consumption,
Alcohol = Alcohol_Consumption,
Smoking = Smoking_History,
Greens = Green_Vegetables_Consumption) %>% mutate(
Heart_Disease = factor(ifelse(Heart_Disease == "Yes", "1", "0"), levels = c("0","1")),
Smoking = factor(ifelse(Smoking == "Yes", 1, 0)),
Exercise = factor(Exercise))
#subset dataframe
lifestyle_df <- cvd[,c(3,4,15:19)]The dataset has 19 variables with a sample size of 308854. There is strong class imbalance between the Heart Disease variable with ‘0’ accounting for ~92% of the dataset.
## Data Quality Check + +`{r message=FALSE, warning=FALSE} +# Missingness by variable +
sum(is.na(cvd))[1] 0lifestyle_df |> count(Heart_Disease) |> mutate(Proportion = round(n / sum(n), 3)) Heart_Disease n Proportion
1 0 283883 0.919
2 1 24971 0.081ggplot(lifestyle_df, aes(x = Heart_Disease, fill = Heart_Disease)) + geom_bar() +
geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5) +
labs(title = "Heart Disease Class Distribution", x = "Heart Disease", y = "Count") +
scale_y_continuous(labels = scales::label_comma())+
theme_bw() +
theme(legend.position = "none") 
#data exploration
head(cvd) General_Health Checkup Exercise Heart_Disease Skin_Cancer
1 Poor Within the past 2 years No 0 No
2 Very Good Within the past year No 1 No
3 Very Good Within the past year Yes 0 No
4 Poor Within the past year Yes 1 No
5 Good Within the past year No 0 No
6 Good Within the past year No 0 No
Other_Cancer Depression Diabetes Arthritis Sex age height weight BMI
1 No No No Yes Female 70-74 150 32.66 14.54
2 No No Yes No Female 70-74 165 77.11 28.29
3 No No Yes No Female 60-64 163 88.45 33.47
4 No No Yes No Male 75-79 180 93.44 28.73
5 No No No No Male 80+ 191 88.45 24.37
6 No Yes No Yes Male 60-64 183 154.22 46.11
Smoking Alcohol Fruit Greens Fries
1 1 0 30 16 12
2 0 0 30 0 4
3 0 4 12 3 16
4 0 0 30 30 8
5 1 0 8 4 0
6 0 0 12 12 12str(cvd)'data.frame': 308854 obs. of 19 variables:
$ General_Health: chr "Poor" "Very Good" "Very Good" "Poor" ...
$ Checkup : chr "Within the past 2 years" "Within the past year" "Within the past year" "Within the past year" ...
$ Exercise : Factor w/ 2 levels "No","Yes": 1 1 2 2 1 1 2 2 1 1 ...
$ Heart_Disease : Factor w/ 2 levels "0","1": 1 2 1 2 1 1 2 1 1 1 ...
$ Skin_Cancer : chr "No" "No" "No" "No" ...
$ Other_Cancer : chr "No" "No" "No" "No" ...
$ Depression : chr "No" "No" "No" "No" ...
$ Diabetes : chr "No" "Yes" "Yes" "Yes" ...
$ Arthritis : chr "Yes" "No" "No" "No" ...
$ Sex : chr "Female" "Female" "Female" "Male" ...
$ age : chr "70-74" "70-74" "60-64" "75-79" ...
$ height : num 150 165 163 180 191 183 175 165 163 163 ...
$ weight : num 32.7 77.1 88.5 93.4 88.5 ...
$ BMI : num 14.5 28.3 33.5 28.7 24.4 ...
$ Smoking : Factor w/ 2 levels "0","1": 2 1 1 1 2 1 2 2 2 1 ...
$ Alcohol : num 0 0 4 0 0 0 0 3 0 0 ...
$ Fruit : num 30 30 12 30 8 12 16 30 12 12 ...
$ Greens : num 16 0 3 30 4 12 8 8 12 12 ...
$ Fries : num 12 4 16 8 0 12 0 8 4 1 ...life_long <- lifestyle_df %>%
pivot_longer(
cols = c(Greens, Fruit,Fries,Alcohol),
names_to = "Food",
values_to = "Value")
ggplot(life_long,aes(Heart_Disease,y=Value, fill = Food=='Alcohol'))+
geom_col(position = "dodge")+
theme_minimal()+
scale_fill_manual(
values = c(`0` = "#440154",
`1` = "#FDE725"))Warning: No shared levels found between `names(values)` of the manual scale and the
data's fill values.
No shared levels found between `names(values)` of the manual scale and the
data's fill values.
life_long %>% select(Heart_Disease,Smoking,Food,Value) %>% group_by(Heart_Disease,Food) %>% summarise(n = sum(Value)) %>%
ggplot(aes(Food,n, fill=Heart_Disease))+
geom_col( position = 'dodge')+
scale_y_continuous(labels = scales::label_comma())+
theme_bw()`summarise()` has grouped output by 'Heart_Disease'. You can override using the
`.groups` argument.
ggplot(life_long) +
aes(x = Food, y = Value, fill = Heart_Disease) +
geom_col() +
scale_fill_hue(direction = 1) +
theme_minimal() +
facet_wrap(vars(Heart_Disease), scales = "free_y")
#life_long %>% select(Heart_Disease,Smoking) %>% filter(Heart_Disease=='1') %>%
# ggplot(life_long,aes(Heart_Disease,fill=Smoking))+
# geom_bar(position = 'dodge')+facet_grid(~Heart_Disease)# Smoking x Heart Disease
ggplot(life_long) +
aes(x = Heart_Disease, fill = Smoking) +
geom_bar(aes(y = after_stat(count / sum(count))), position = "dodge2") +
scale_fill_manual(values = c(`0` = "#440154", `1` = "#FDE725")) +
labs(title = "Smoking x Heart Disease", y = "Proportion") +
theme_bw() +
facet_wrap(vars(Heart_Disease), scales = "free")
# Exercise x Heart Disease
ggplot(life_long) +
aes(x = Heart_Disease, fill = Exercise) +
geom_bar(aes(y = after_stat(count / sum(count))), position = "dodge2") +
scale_fill_manual(values = c(No = "#440154", Yes = "#FDE725")) +
labs(title = "Exercise x Heart Disease", y = "Proportion") +
theme_bw() +
facet_wrap(vars(Heart_Disease), scales = "free")
From the graphs above, we can see that smoking is much higher represented in the heart disease group. Inversely, given no heart disease ‘no smoking’ represents much higher proportion of the population
A different trend is observed for exercise such that while exercise is in higher proportion in both Heart Disease populations, it is much more likely for those who do not have heart disease to indicate that they do exercise.
A logistic regression to determine what variables are significant predictors of heart disease diagnosis
# compute class weights to correct for 92/8 imbalance
class_counts <- table(lifestyle_df$Heart_Disease)
class_weights <- 1 / class_counts[lifestyle_df$Heart_Disease]
#class_weights
life_lm <- glm(Heart_Disease ~ ., data = lifestyle_df,
family = binomial());summary(life_lm)
Call:
glm(formula = Heart_Disease ~ ., family = binomial(), data = lifestyle_df)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.2029434 0.0173526 -126.952 < 2e-16 ***
ExerciseYes -0.6219205 0.0144355 -43.083 < 2e-16 ***
Smoking1 0.7679578 0.0136314 56.337 < 2e-16 ***
Alcohol -0.0187079 0.0009083 -20.596 < 2e-16 ***
Fruit 0.0002526 0.0002857 0.884 0.377
Greens -0.0022513 0.0004931 -4.566 4.98e-06 ***
Fries -0.0070181 0.0008540 -8.218 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 173478 on 308853 degrees of freedom
Residual deviance: 167313 on 308847 degrees of freedom
AIC: 167327
Number of Fisher Scoring iterations: 5life_lm_reduced <- glm(Heart_Disease ~ . - Fruit, data = lifestyle_df,
family = binomial())
anova(life_lm_reduced, life_lm, test = "Chisq") # no leading +Analysis of Deviance Table
Model 1: Heart_Disease ~ (Exercise + Smoking + Alcohol + Fruit + Greens +
Fries) - Fruit
Model 2: Heart_Disease ~ Exercise + Smoking + Alcohol + Fruit + Greens +
Fries
Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1 308848 167313
2 308847 167313 1 0.78005 0.3771cbind(minus_fruit = AIC(life_lm_reduced), with_fruit = AIC(life_lm)) minus_fruit with_fruit
[1,] 167325.4 167326.6round(exp(cbind(OR = coef(life_lm_reduced),
confint.default(life_lm_reduced))), 3) OR 2.5 % 97.5 %
(Intercept) 0.111 0.108 0.115
ExerciseYes 0.538 0.523 0.553
Smoking1 2.153 2.097 2.212
Alcohol 0.981 0.980 0.983
Greens 0.998 0.997 0.999
Fries 0.993 0.991 0.995#main effects
lifestyle_df$Heart_Disease<-relevel(lifestyle_df$Heart_Disease, ref = "0")
life_unweight<-glm(Heart_Disease ~., data = lifestyle_df, family = binomial(link = "logit"))
summary(life_lm)
Call:
glm(formula = Heart_Disease ~ ., family = binomial(), data = lifestyle_df)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.2029434 0.0173526 -126.952 < 2e-16 ***
ExerciseYes -0.6219205 0.0144355 -43.083 < 2e-16 ***
Smoking1 0.7679578 0.0136314 56.337 < 2e-16 ***
Alcohol -0.0187079 0.0009083 -20.596 < 2e-16 ***
Fruit 0.0002526 0.0002857 0.884 0.377
Greens -0.0022513 0.0004931 -4.566 4.98e-06 ***
Fries -0.0070181 0.0008540 -8.218 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 173478 on 308853 degrees of freedom
Residual deviance: 167313 on 308847 degrees of freedom
AIC: 167327
Number of Fisher Scoring iterations: 5round(exp(cbind(OR = coef(life_lm), confint.default(life_lm))),3) OR 2.5 % 97.5 %
(Intercept) 0.110 0.107 0.114
ExerciseYes 0.537 0.522 0.552
Smoking1 2.155 2.099 2.214
Alcohol 0.981 0.980 0.983
Fruit 1.000 1.000 1.001
Greens 0.998 0.997 0.999
Fries 0.993 0.991 0.995library(broom)
aug_df <- augment(life_lm_reduced, type.predict = "response", type.residuals = "deviance")
ggplot(aug_df, aes(x = .fitted, y = .resid)) +
geom_point(alpha = 0.1) +
geom_smooth(se = FALSE, colour = "#440154") +
geom_hline(yintercept = 0, linetype = "dashed", colour = "grey50") +
labs(title = "Deviance residuals vs fitted values",
x = "Fitted probability", y = "Deviance residual") +
theme_bw()`geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
unweight_df <- augment(life_unweight , type.predict = "response", type.residuals = "deviance")
ggplot(unweight_df, aes(x = .fitted, y = .resid)) +
geom_point(alpha = 0.1) +
geom_smooth(se = FALSE, colour = "#440154") +
geom_hline(yintercept = 0, linetype = "dashed", colour = "grey50") +
labs(title = "Deviance residuals vs fitted values",
x = "Fitted probability", y = "Deviance residual") +
theme_bw()`geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
The main effects model indicates that only fruit consumption is not a statistical significant covariate, and the model could likely be improved by removing it. Smoking has a high odds of heart disease with (~2.15 OR) . Surprisingly, Fruit, Greens and Fries Consumption shows effectively little to no difference in odds of a positive heart disease (1.0, .99, .99,1.00) and the confidence intervals are very close to 1. Alcohol consumption indicates a 2.2% decrease in odds for every 1 extra alcoholic drink taken. Only exercise seems to have a protective effect with a 0.53 (0.980, 0.983) odds of a heart attack compared to those that don’t exercise. The seeming protective effects of fries consumption on heart-disease outcome should be investigated as there may be confounding variable or it may indicate that given a heart disease diagnoses may reduce alcohol and fries intake.
life_lm_reduced <- glm(Heart_Disease ~ . - Fruit, data = lifestyle_df, family = binomial())
+ anova(life_lm_reduced, life_lm, test = 'Chisq') Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1 308848 167313.4 NA NA NA
2 308847 167312.6 1 0.780054 0.3771246#comparing AIC
cbind(minus_fruit=AIC(life_lm_reduced),with_fruit=AIC(life_lm)) minus_fruit with_fruit
[1,] 167325.4 167326.6Removing fruit from the main model improved the model’s AIC score and comparing the models with a chi-square test indicates that they are not statistically different.
life_lm_interact <- glm(Heart_Disease ~ .^2, data = lifestyle_df,
family = binomial())
summary(life_lm_interact)
Call:
glm(formula = Heart_Disease ~ .^2, family = binomial(), data = lifestyle_df)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.216e+00 2.971e-02 -74.588 < 2e-16 ***
ExerciseYes -6.155e-01 3.215e-02 -19.146 < 2e-16 ***
Smoking1 7.343e-01 3.100e-02 23.689 < 2e-16 ***
Alcohol -1.821e-02 2.647e-03 -6.881 5.96e-12 ***
Fruit 1.847e-03 6.766e-04 2.730 0.006326 **
Greens 2.094e-03 1.248e-03 1.679 0.093216 .
Fries -1.388e-02 2.085e-03 -6.661 2.72e-11 ***
ExerciseYes:Smoking1 1.225e-01 2.950e-02 4.153 3.28e-05 ***
ExerciseYes:Alcohol -2.903e-04 2.031e-03 -0.143 0.886324
ExerciseYes:Fruit -1.660e-03 6.225e-04 -2.667 0.007653 **
ExerciseYes:Greens -2.718e-03 1.073e-03 -2.534 0.011277 *
ExerciseYes:Fries 2.169e-05 1.733e-03 0.013 0.990012
Smoking1:Alcohol -4.690e-04 1.979e-03 -0.237 0.812627
Smoking1:Fruit -3.857e-04 5.771e-04 -0.668 0.503975
Smoking1:Greens -4.616e-03 9.946e-04 -4.641 3.47e-06 ***
Smoking1:Fries 5.149e-03 1.769e-03 2.910 0.003614 **
Alcohol:Fruit -1.142e-05 4.043e-05 -0.283 0.777489
Alcohol:Greens 4.452e-05 6.715e-05 0.663 0.507308
Alcohol:Fries -3.320e-05 1.126e-04 -0.295 0.768028
Fruit:Greens -2.883e-05 1.639e-05 -1.759 0.078629 .
Fruit:Fries 4.453e-05 3.087e-05 1.443 0.149151
Greens:Fries 1.191e-04 3.229e-05 3.687 0.000227 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 173478 on 308853 degrees of freedom
Residual deviance: 167229 on 308832 degrees of freedom
AIC: 167273
Number of Fisher Scoring iterations: 5anova(life_lm_reduced, life_lm_interact, test = "Chisq")Analysis of Deviance Table
Model 1: Heart_Disease ~ (Exercise + Smoking + Alcohol + Fruit + Greens +
Fries) - Fruit
Model 2: Heart_Disease ~ (Exercise + Smoking + Alcohol + Fruit + Greens +
Fries)^2
Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1 308848 167313
2 308832 167229 16 84.1 3.01e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1cbind(AIC(life_lm_reduced), AIC(life_lm_interact)) [,1] [,2]
[1,] 167325.4 167273.3exp(cbind(OR = coef(life_lm), confint.default(life_lm))) OR 2.5 % 97.5 %
(Intercept) 0.1104775 0.1067833 0.1142995
ExerciseYes 0.5369123 0.5219343 0.5523202
Smoking1 2.1553601 2.0985377 2.2137211
Alcohol 0.9814660 0.9797203 0.9832148
Fruit 1.0002526 0.9996927 1.0008128
Greens 0.9977512 0.9967874 0.9987159
Fries 0.9930065 0.9913457 0.9946700test<-glm(Heart_Disease~ ., data = cvd, family = binomial,weights = class_weights); summary(test)
Call:
glm(formula = Heart_Disease ~ ., family = binomial, data = cvd,
weights = class_weights)
Coefficients:
Estimate Std. Error
(Intercept) -4.121e+00 1.239e+02
General_HealthFair 1.753e+00 7.526e+00
General_HealthGood 1.069e+00 6.664e+00
General_HealthPoor 2.321e+00 9.766e+00
General_HealthVery Good 4.994e-01 6.701e+00
CheckupNever 1.256e-01 3.339e+01
CheckupWithin the past 2 years 1.693e-01 1.293e+01
CheckupWithin the past 5 years 7.563e-02 1.512e+01
CheckupWithin the past year 4.870e-01 1.166e+01
ExerciseYes -3.788e-02 4.163e+00
Skin_CancerYes 1.108e-01 5.207e+00
Other_CancerYes 1.204e-01 5.126e+00
DepressionYes 2.980e-01 4.546e+00
DiabetesNo, pre-diabetes or borderline diabetes 1.932e-01 1.033e+01
DiabetesYes 5.910e-01 4.534e+00
DiabetesYes, but female told only during pregnancy 1.083e-01 2.304e+01
ArthritisYes 3.018e-01 3.729e+00
SexMale 8.989e-01 5.126e+00
age25-29 2.825e-01 2.349e+01
age30-34 5.729e-01 2.127e+01
age35-39 6.839e-01 2.040e+01
age40-44 9.876e-01 1.956e+01
age45-49 1.369e+00 1.902e+01
age50-54 1.674e+00 1.848e+01
age55-59 2.030e+00 1.817e+01
age60-64 2.283e+00 1.800e+01
age65-69 2.538e+00 1.796e+01
age70-74 2.802e+00 1.800e+01
age75-79 3.060e+00 1.827e+01
age80+ 3.402e+00 1.823e+01
height -3.817e-03 7.211e-01
weight -2.277e-03 6.702e-01
BMI 9.053e-03 1.931e+00
Smoking1 4.329e-01 3.580e+00
Alcohol -9.483e-03 2.145e-01
Fruit 9.184e-05 7.446e-02
Greens 1.365e-03 1.277e-01
Fries -4.555e-04 2.128e-01
z value Pr(>|z|)
(Intercept) -0.033 0.973
General_HealthFair 0.233 0.816
General_HealthGood 0.160 0.873
General_HealthPoor 0.238 0.812
General_HealthVery Good 0.075 0.941
CheckupNever 0.004 0.997
CheckupWithin the past 2 years 0.013 0.990
CheckupWithin the past 5 years 0.005 0.996
CheckupWithin the past year 0.042 0.967
ExerciseYes -0.009 0.993
Skin_CancerYes 0.021 0.983
Other_CancerYes 0.023 0.981
DepressionYes 0.066 0.948
DiabetesNo, pre-diabetes or borderline diabetes 0.019 0.985
DiabetesYes 0.130 0.896
DiabetesYes, but female told only during pregnancy 0.005 0.996
ArthritisYes 0.081 0.936
SexMale 0.175 0.861
age25-29 0.012 0.990
age30-34 0.027 0.979
age35-39 0.034 0.973
age40-44 0.050 0.960
age45-49 0.072 0.943
age50-54 0.091 0.928
age55-59 0.112 0.911
age60-64 0.127 0.899
age65-69 0.141 0.888
age70-74 0.156 0.876
age75-79 0.168 0.867
age80+ 0.187 0.852
height -0.005 0.996
weight -0.003 0.997
BMI 0.005 0.996
Smoking1 0.121 0.904
Alcohol -0.044 0.965
Fruit 0.001 0.999
Greens 0.011 0.991
Fries -0.002 0.998
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 2.7726 on 308853 degrees of freedom
Residual deviance: 1.9947 on 308816 degrees of freedom
AIC: 76
Number of Fisher Scoring iterations: 5# KS test on n=300k is useless — use visual inspection instead
ggplot(lifestyle_df, aes(sample = Fruit)) +
stat_qq() +
stat_qq_line(colour = "steelblue") +
labs(title = "Q-Q plot: Fruit consumption") +
theme_bw()
# t-tests are still fine — keep these
var.test(lifestyle_df$Fruit ~ lifestyle_df$Heart_Disease)
F test to compare two variances
data: lifestyle_df$Fruit by lifestyle_df$Heart_Disease
F = 1.0387, num df = 283882, denom df = 24970, p-value = 5.209e-05
alternative hypothesis: true ratio of variances is not equal to 1
95 percent confidence interval:
1.019821 1.057831
sample estimates:
ratio of variances
1.038726 t.test(lifestyle_df$Fruit ~ lifestyle_df$Heart_Disease,
mu = 0, var.equal = FALSE, alternative = "greater")
Welch Two Sample t-test
data: lifestyle_df$Fruit by lifestyle_df$Heart_Disease
t = 11.326, df = 29720, p-value < 2.2e-16
alternative hypothesis: true difference in means between group 0 and group 1 is greater than 0
95 percent confidence interval:
1.564253 Inf
sample estimates:
mean in group 0 mean in group 1
29.98316 28.15314 var.test(lifestyle_df$Fries ~ lifestyle_df$Heart_Disease)
F test to compare two variances
data: lifestyle_df$Fries by lifestyle_df$Heart_Disease
F = 1.0195, num df = 283882, denom df = 24970, p-value = 0.0397
alternative hypothesis: true ratio of variances is not equal to 1
95 percent confidence interval:
1.000910 1.038215
sample estimates:
ratio of variances
1.019464 t.test(lifestyle_df$Fries ~ lifestyle_df$Heart_Disease,
mu = 0, var.equal = FALSE, alternative = "two.sided")
Welch Two Sample t-test
data: lifestyle_df$Fries by lifestyle_df$Heart_Disease
t = 5.1697, df = 29628, p-value = 2.361e-07
alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
95 percent confidence interval:
0.1803644 0.4006544
sample estimates:
mean in group 0 mean in group 1
6.320104 6.029594 lifestyle_df$Heart_Disease<-relevel(lifestyle_df$Heart_Disease, ref = "0")
cvd$Heart_Disease<-ifelse(cvd$Heart_Disease=="Yes","1","0")
fries_lm<-glm( as.factor(Heart_Disease) ~age*Fruit, data = cvd, family = binomial(link = "logit"))Warning: glm.fit: algorithm did not convergesummary(fries_lm)
Call:
glm(formula = as.factor(Heart_Disease) ~ age * Fruit, family = binomial(link = "logit"),
data = cvd)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.657e+01 3.874e+03 -0.007 0.995
age25-29 -9.919e-21 5.803e+03 0.000 1.000
age30-34 -1.002e-20 5.595e+03 0.000 1.000
age35-39 -1.006e-20 5.485e+03 0.000 1.000
age40-44 -1.009e-20 5.419e+03 0.000 1.000
age45-49 -1.009e-20 5.424e+03 0.000 1.000
age50-54 -1.009e-20 5.192e+03 0.000 1.000
age55-59 -1.003e-20 5.078e+03 0.000 1.000
age60-64 -9.971e-21 4.951e+03 0.000 1.000
age65-69 -9.956e-21 4.952e+03 0.000 1.000
age70-74 -6.906e-12 5.029e+03 0.000 1.000
age75-79 -1.010e-20 5.556e+03 0.000 1.000
age80+ -1.016e-20 5.532e+03 0.000 1.000
Fruit -1.601e-22 1.075e+02 0.000 1.000
age25-29:Fruit 1.622e-22 1.609e+02 0.000 1.000
age30-34:Fruit 1.646e-22 1.513e+02 0.000 1.000
age35-39:Fruit 1.654e-22 1.456e+02 0.000 1.000
age40-44:Fruit 1.658e-22 1.438e+02 0.000 1.000
age45-49:Fruit 1.662e-22 1.455e+02 0.000 1.000
age50-54:Fruit 1.664e-22 1.400e+02 0.000 1.000
age55-59:Fruit 1.652e-22 1.371e+02 0.000 1.000
age60-64:Fruit 1.643e-22 1.333e+02 0.000 1.000
age65-69:Fruit 1.642e-22 1.328e+02 0.000 1.000
age70-74:Fruit 3.526e-15 1.353e+02 0.000 1.000
age75-79:Fruit 1.664e-22 1.467e+02 0.000 1.000
age80+:Fruit 1.677e-22 1.455e+02 0.000 1.000
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 0.0000e+00 on 308853 degrees of freedom
Residual deviance: 1.7918e-06 on 308828 degrees of freedom
AIC: 52
Number of Fisher Scoring iterations: 25 ggplot(data = lifestyle_df,aes(Fries))+
geom_density()
ggplot(data=cvd,aes(age,Fries,fill=age))+
geom_col()+
facet_grid(rows = vars(Heart_Disease))
# soime visualizations
library(ggplot2)
library(patchwork)Warning: package 'patchwork' was built under R version 4.5.3p1 <- ggplot(lifestyle_df, aes(x = Fries, fill = factor(Heart_Disease))) +
geom_histogram(bins = 40, position = "fill") +
labs(title = "Fries: Proportion with Heart Disease by Value",
x = "Fries (servings/month?)", y = "Proportion", fill = "Heart Disease")
p2 <- ggplot(lifestyle_df, aes(x = Alcohol, fill = factor(Heart_Disease))) +
geom_histogram(bins = 30, position = "fill") +
labs(title = "Alcohol: Proportion with Heart Disease by Value",
x = "Alcohol (drinks/month?)", y = "Proportion", fill = "Heart Disease")
p1 / p2
#model test
# train/test split
train_idx <- createDataPartition(lifestyle_df$Heart_Disease, p = 0.8, list = FALSE)
train_df <- lifestyle_df[ train_idx, ]
test_df <- lifestyle_df[-train_idx, ]
train_weights <- class_weights[train_idx]
final_model <- glm(Heart_Disease ~ . - Fruit, data = train_df,
family = binomial())
# predictions on test set
pred_prob <- predict(final_model, newdata = test_df, type = "response")
pred_class <- factor(ifelse(pred_prob > 0.5, "1", "0"), levels = c("0", "1"))
# confusion matrix
confusionMatrix(pred_class, test_df$Heart_Disease, positive = "1")Confusion Matrix and Statistics
Reference
Prediction 0 1
0 56776 4994
1 0 0
Accuracy : 0.9192
95% CI : (0.917, 0.9213)
No Information Rate : 0.9192
P-Value [Acc > NIR] : 0.5038
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.00000
Specificity : 1.00000
Pos Pred Value : NaN
Neg Pred Value : 0.91915
Prevalence : 0.08085
Detection Rate : 0.00000
Detection Prevalence : 0.00000
Balanced Accuracy : 0.50000
'Positive' Class : 1
# ROC / AUC
roc_obj <- roc(test_df$Heart_Disease, pred_prob)Setting levels: control = 0, case = 1Setting direction: controls < casesauc(roc_obj)Area under the curve: 0.6479ggroc(roc_obj, colour = "#440154") +
geom_abline(slope = 1, intercept = 1, linetype = "dashed", colour = "grey60") +
labs(title = paste0("ROC curve (AUC = ", round(auc(roc_obj), 3), ")"),
x = "Specificity", y = "Sensitivity") +
theme_bw()
library(broom)
or_df <- tidy(life_lm_reduced, exponentiate = TRUE, conf.int = TRUE) %>%
filter(term != "(Intercept)")
ggplot(or_df, aes(x = estimate, y = reorder(term, estimate))) +
geom_point(size = 3, colour = "#440154") +
geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), height = 0.2) +
geom_vline(xintercept = 1, linetype = "dashed", colour = "grey50") +
labs(title = "Odds ratios (95% CI)", x = "Odds ratio", y = NULL) +
theme_bw()Warning: `geom_errorbarh()` was deprecated in ggplot2 4.0.0.
ℹ Please use the `orientation` argument of `geom_errorbar()` instead.`height` was translated to `width`.