Dataset
The dataset evaluates the obesity risk based on factors such as gender, age, number of meals, consumption of alcohol, physical activity frequency, etc. It includes 20758 observations and 18 columns
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── 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 errorsmy_data <- read.csv("obesity_level.csv")
summary(my_data)## id Gender Age Height
## Min. : 0 Length :20758 Min. :14.00 Min. :1.450
## 1st Qu.: 5189 N.unique : 2 1st Qu.:20.00 1st Qu.:1.632
## Median :10378 N.blank : 0 Median :22.82 Median :1.700
## Mean :10378 Min.nchar: 4 Mean :23.84 Mean :1.700
## 3rd Qu.:15568 Max.nchar: 6 3rd Qu.:26.00 3rd Qu.:1.763
## Max. :20757 Max. :61.00 Max. :1.976
## Weight family_history_with_overweight FAVC
## Min. : 39.00 Min. :0.0000 Min. :0.0000
## 1st Qu.: 66.00 1st Qu.:1.0000 1st Qu.:1.0000
## Median : 84.06 Median :1.0000 Median :1.0000
## Mean : 87.89 Mean :0.8196 Mean :0.9144
## 3rd Qu.:111.60 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :165.06 Max. :1.0000 Max. :1.0000
## FCVC NCP CAEC SMOKE
## Min. :1.000 Min. :1.000 Length :20758 Min. :0.0000
## 1st Qu.:2.000 1st Qu.:3.000 N.unique : 4 1st Qu.:0.0000
## Median :2.394 Median :3.000 N.blank : 0 Median :0.0000
## Mean :2.446 Mean :2.761 Min.nchar: 1 Mean :0.0118
## 3rd Qu.:3.000 3rd Qu.:3.000 Max.nchar: 10 3rd Qu.:0.0000
## Max. :3.000 Max. :4.000 Max. :1.0000
## CH2O SCC FAF TUE
## Min. :1.000 Min. :0.0000 Min. :0.000000 Min. :0.0000
## 1st Qu.:1.792 1st Qu.:0.0000 1st Qu.:0.008013 1st Qu.:0.0000
## Median :2.000 Median :0.0000 Median :1.000000 Median :0.5739
## Mean :2.029 Mean :0.0331 Mean :0.981747 Mean :0.6168
## 3rd Qu.:2.550 3rd Qu.:0.0000 3rd Qu.:1.587406 3rd Qu.:1.0000
## Max. :3.000 Max. :1.0000 Max. :3.000000 Max. :2.0000
## CALC MTRANS X0be1dad
## Length :20758 Length :20758 Length :20758
## N.unique : 3 N.unique : 5 N.unique : 7
## N.blank : 0 N.blank : 0 N.blank : 0
## Min.nchar: 1 Min.nchar: 4 Min.nchar: 12
## Max.nchar: 10 Max.nchar: 21 Max.nchar: 19
## Histogram plot
hist(my_data$FAF, breaks = 5, xlab="Hours",
main = "Physical Activity Frequency",
col = "#60B8A3",
border = "white")
The histogram shows the distribution of time (hours) spent on physical activity of participants. The right-skewed distribution indicates that the majority of individuals spend between 0.0 and 1.0 hours for physical activity.
Interestingly, the distribution shows a secondary peak at 1.5 to 2.0 hours, representing a significant proportion of participants with physical activity duration.
We assume that this peak comes from the young people - those in their prime - who are ready to devote more time to physical activity.
Let’s see
group_15_20 <- my_data %>%
filter(FAF >= 1.5, FAF <= 2.0)
ggplot(group_15_20, aes(x = Age)) +
geom_histogram(binwidth=5, fill ='steelblue', color='white')+
labs(title = "Age distribution of individuals with 1.5 - 2.0 hours for physical activity",
x = "Age",
y = "Count") +
theme_minimal()
From the graph, we easily see that most of the participants whose age is around 20 devote 1.5 to 2.0 hours to physical activity.
Statistical Calculation
Mean of Physical Activity Frequency
mean_activity <- mean(my_data$FAF, na.rm = TRUE)
mean_activity## [1] 0.9817466Standard deviation of Physical Activity Frequency
sd_activity <- sd(my_data$FAF, na.rm = TRUE)
sd_activity## [1] 0.838302Apply correlation
to detect a relationship between Age and Physical Activity Frequency
cor.test(my_data$Age, my_data$FAF)##
## Pearson's product-moment correlation
##
## data: my_data$Age and my_data$FAF
## t = -28.225, df = 20756, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2053258 -0.1791238
## sample estimates:
## cor
## -0.1922591R-squared and p-value
linear_age_faf <- lm(FAF ~ Age, data = my_data)
summary(linear_age_faf)##
## Call:
## lm(formula = FAF ~ Age, data = my_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.26061 -0.83368 -0.06227 0.60070 2.90112
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.657303 0.024606 67.35 <2e-16 ***
## Age -0.028335 0.001004 -28.23 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8227 on 20756 degrees of freedom
## Multiple R-squared: 0.03696, Adjusted R-squared: 0.03692
## F-statistic: 796.7 on 1 and 20756 DF, p-value: < 2.2e-16Scatter plot
ggplot(my_data, aes(x = Age, y = FAF)) +
geom_point(alpha = 0.5, color = "darkgreen") +
geom_smooth(method="lm", color='red') +
theme_minimal() +
labs(title = "Age vs Physical Activity Frequency",
x = "Age",
y = "Physical Activity Frequency")## `geom_smooth()` using formula = 'y ~ x'
The correlation coefficient is -0.19, indicating that a weak relationship. In the other hand, when age increases, the Physical Activity Frequency tends to decrease slightly.
The p-value < 2.2e-16, showing that the relation is statistically significant. The linear regression model produced R-squared = 0.03696, meaning Age explains only 3.7% of the variation in Physical Activity Frequency. Therefore, although Age has a statistically significant impact on physical activity, it is not a strong predictor, and other factors might play a much larger role.
Second statistic test
ggplot(my_data, aes(x = Weight)) +
geom_histogram(binwidth = 5, fill = "orange", color = "white") +
geom_text(stat = "bin",
binwidth = 5,
aes(label = ..count..),
vjust = -0.5,
color = "black",
size = 3) +
labs(title = "Weight Distribution", x = "Weight", y = "Count") +
theme_minimal()## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
The Weight distribution is not normal It spreads widely across the range of weights. It shows clear peaks around: 50, 80, 110, and 120. This indicates that weight in the dataset is not centered around a single value but forms multiple clusters
T-test
I divided my dataset into two groups based on the variable Gender (Male vs Female) and used t-test to test for significant differences between the two groups.
t.test(Weight ~ Gender, data = my_data)##
## Welch Two Sample t-test
##
## data: Weight by Gender
## t = -17.231, df = 19187, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Female and group Male is not equal to 0
## 95 percent confidence interval:
## -6.969635 -5.545940
## sample estimates:
## mean in group Female mean in group Male
## 84.77184 91.02963The t‑test: The mean Weight for males is 91.03, while the mean Weight of females is 84.77 the p-value < 0.05, indicating that the difference is statistically significant.