TP8 clinics - Obesity - Report
Bilille
2026-02-18
Report on data from TP8 - Obesity
This document is a report that analyses the data of TP8 clinics - Obesity.
Data and context
We analysed the dataset retrieved on the following website https://archive.ics.uci.edu.
This dataset includes obese patients with different levels of obesity,
for whom we have information about gender, age, medical history, and
daily routines (such as smoking, eating vegetables, ..).
Importing and exploring the data
Importing data
We are going to use one table for this analysis :
obesity_with_na.csvwhich contains clinical data mainly on obese individuals
Details of the different variables are described here :
## 1.1
# The `stringsAsFactors` option allows to consider every character variable as factor
obesity_with_na = read.csv("./obesity_with_na.csv",
stringsAsFactors=TRUE)
## 1.2
# dim(obesity_with_na)
# Let's print a sentence with text and numbers using the paste() function
# First saving the dimensions into a vector
dimensions = dim(obesity_with_na) # this is now a vector with two values
# Second using it into the Paste function that allows to concatenate characters
print(paste("There are", dimensions[1], "individuals and", dimensions[2], "variables in our dataset."))## [1] "There are 2111 individuals and 17 variables in our dataset."## 1.3
cat("Here is the summary of the dataset :\n")## Here is the summary of the dataset :summary(obesity_with_na)## Gender Age Height Weight
## Female:1040 Min. :14.00 Min. :1.450 Min. : 39.00
## Male :1068 1st Qu.:19.95 1st Qu.:1.630 1st Qu.: 65.62
## NA's : 3 Median :22.78 Median :1.701 Median : 83.00
## Mean :24.32 Mean :1.702 Mean : 86.62
## 3rd Qu.:26.00 3rd Qu.:1.769 3rd Qu.:107.54
## Max. :61.00 Max. :1.980 Max. :173.00
## NA's :6 NA's :10 NA's :5
## family_history_with_overweight FAVC FCVC NCP
## no : 383 no : 245 Min. :1.000 Min. :1.000
## yes :1719 yes :1860 1st Qu.:2.000 1st Qu.:2.659
## NA's: 9 NA's: 6 Median :2.381 Median :3.000
## Mean :2.419 Mean :2.685
## 3rd Qu.:3.000 3rd Qu.:3.000
## Max. :3.000 Max. :4.000
## NA's :8 NA's :2
## CAEC SMOKE CH2O SCC FAF
## Always : 52 no :2060 Min. :1.000 no :2014 Min. :0.0000
## Frequently: 242 yes : 44 1st Qu.:1.585 yes : 95 1st Qu.:0.1245
## no : 51 NA's: 7 Median :2.000 NA's: 2 Median :1.0000
## Sometimes :1761 Mean :2.008 Mean :1.0099
## NA's : 5 3rd Qu.:2.480 3rd Qu.:1.6667
## Max. :3.000 Max. :3.0000
## NA's :4 NA's :4
## TUE CALC MTRANS
## Min. :0.0000 Always : 1 Automobile : 457
## 1st Qu.:0.0000 Frequently: 69 Bike : 7
## Median :0.6253 no : 635 Motorbike : 11
## Mean :0.6576 Sometimes :1395 Public_Transportation:1571
## 3rd Qu.:1.0000 NA's : 11 Walking : 56
## Max. :2.0000 NA's : 9
## NA's :5
## NObeyesdad
## Obesity_Type_I :349
## Obesity_Type_III :324
## Obesity_Type_II :296
## Overweight_Level_I :288
## Overweight_Level_II:288
## (Other) :557
## NA's : 9## 1.4
cat("Here is the contingency table for Gender variable :")## Here is the contingency table for Gender variable :table(obesity_with_na$Gender) # Contingency table for Gender variable##
## Female Male
## 1040 1068cat("Here is the contingency table for SMOKE variable :")## Here is the contingency table for SMOKE variable :table(obesity_with_na$SMOKE) # Contingency table for SMOKE variable##
## no yes
## 2060 44cat("Here is the contingency table for Gender x SMOKE variables :")## Here is the contingency table for Gender x SMOKE variables :table(obesity_with_na$Gender, obesity_with_na$SMOKE) # Contingency table for Gender x SMOKE variables##
## no yes
## Female 1022 15
## Male 1035 29Dealing with missing values
We are aiming to have a table with no missing values, so we filtered every individual getting missing values.
## 2.1
library(tidyverse)
## 2.2
obesity_without_na <- obesity_with_na %>% drop_na()
## 2.3
n_ind <- dim(obesity_without_na)[1] # Using the first element of the vector returned by `dim`
# To print the number of individuals in a sentance :
print(paste("There are", n_ind, "individuals with no missing values. We removed", nrow(obesity_with_na) - nrow(obesity_without_na), "individuals with at least one missing value among the", ncol(obesity_with_na), "variables."))## [1] "There are 2006 individuals with no missing values. We removed 105 individuals with at least one missing value among the 17 variables."Adding variables
We want to add the variable BMI to our datatable with no
missing values.
## 3.1
# Using the $ to access the variable
obesity_without_na$BMI = obesity_without_na$Weight / (obesity_without_na$Height ** 2)Here is a summary of this new BMI variable :
## 3.2
# `Summary` function can be applied on a single variable
summary(obesity_without_na$BMI)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.00 24.34 28.78 29.72 36.05 50.81Now we want to focus on obese patients, that means
patients with a BMI greater thant 25.
Here is a summary of these patients :
## 3.3
# Using `subset` function
obese_individuals = subset(obesity_without_na, BMI > 25)
## 3.4
summary(obese_individuals)## Gender Age Height Weight
## Female:682 Min. :15.00 Min. :1.456 Min. : 55.52
## Male :782 1st Qu.:21.01 1st Qu.:1.641 1st Qu.: 80.13
## Median :24.00 Median :1.710 Median : 97.43
## Mean :25.65 Mean :1.710 Mean : 98.01
## 3rd Qu.:28.87 3rd Qu.:1.774 3rd Qu.:112.73
## Max. :56.00 Max. :1.980 Max. :173.00
##
## family_history_with_overweight FAVC FCVC NCP
## no : 95 no : 108 Min. :1.000 Min. :1.000
## yes:1369 yes:1356 1st Qu.:2.000 1st Qu.:2.570
## Median :2.356 Median :3.000
## Mean :2.427 Mean :2.639
## 3rd Qu.:3.000 3rd Qu.:3.000
## Max. :3.000 Max. :4.000
##
## CAEC SMOKE CH2O SCC FAF
## Always : 14 no :1436 Min. :1.000 no :1429 Min. :0.0000
## Frequently: 36 yes: 28 1st Qu.:1.679 yes: 35 1st Qu.:0.1124
## no : 37 Median :2.003 Median :0.9499
## Sometimes :1377 Mean :2.074 Mean :0.9304
## 3rd Qu.:2.580 3rd Qu.:1.4771
## Max. :3.000 Max. :3.0000
##
## TUE CALC MTRANS
## Min. :0.000000 Always : 0 Automobile : 351
## 1st Qu.:0.001628 Frequently: 49 Bike : 3
## Median :0.548920 no : 388 Motorbike : 5
## Mean :0.612998 Sometimes :1027 Public_Transportation:1088
## 3rd Qu.:0.999451 Walking : 17
## Max. :2.000000
##
## NObeyesdad BMI
## Insufficient_Weight: 0 Min. :25.00
## Normal_Weight : 0 1st Qu.:27.94
## Obesity_Type_I :336 Median :32.42
## Obesity_Type_II :286 Mean :33.38
## Obesity_Type_III :308 3rd Qu.:37.83
## Overweight_Level_I :263 Max. :50.81
## Overweight_Level_II:271Visualization
Histogram of BMI
The histogram will allow us to visualize the distribution of the
BMI.
ggplot(obesity_without_na) +
aes(x = BMI) +
geom_histogram(aes(y = after_stat(density)), # Add the density line
bins = 30L, fill = "#D282E6") +
labs( # `labs()` enables to specify labels (title, axes, ..)
x = "BMI",
y = "Frequency",
title = "Distribution of BMI"
) +
geom_vline(xintercept = c(18.5, 25, 40), # Allow to print both vertical lines in the same command
colour = c("blue","forestgreen", "orange"), # Give 2 different colors to the vertical lines
linewidth = c(2, 3, 1.5)) + # Give 2 different line width to the vertical lines
geom_density(colour = "brown", linewidth = 1.4) # For the density line
The vertical lines represent the different thresholds :
- the blue one separates the
underweightfromnormal weightpeople
- the green one separates the
normal weightfromobesepeople
- the orange one separates the
obesefrommorbid obesitypeople
Scatter plot
We want to visualize the height versus
weight variables, colored by class of obesity
first, and BMI then.
## 5.1
fig = ggplot(obesity_without_na) +
aes(x = Height, y = Weight, color = NObeyesdad) +
geom_point()
## 5.2
fig = fig + labs(x = "Height (m)", y = "Weight (kg)", color = "Class of obesity")
## 5.3
centroids = obesity_without_na %>% group_by(NObeyesdad) %>% summarise(
mean_by_categ_height = mean(Height),
mean_by_categ_weight = mean(Weight)
)
## 5.4
fig = fig + geom_point(
data = centroids,
aes(x = mean_by_categ_height, y = mean_by_categ_weight),
color = "black", # Draw them in black for greater visibility
size = 5, # Increase the size for gretaer visibility
shape = 8 # Change the shape for greater visibility
)
## Print fig :
fig
Classes of obesity are clearly identifiables on the graph. We added
the centroids of each class : it’s interesting to note that every class
has an average of Height around 1.7m, except
the Obesity type II for whom it’s closer to
1.8m.
## 5.5
ggplot(obesity_without_na) +
aes(
x = Height,
y = Weight,
colour = BMI,
shape = family_history_with_overweight # Change shape depending on a variable
) +
geom_point(size = 2.2) + # Change point size in general
scale_color_distiller(palette = "OrRd", direction = 1) +
scale_shape_manual(values = c(19, 18)) + # Change shapes for both modalities of family history
labs(title = "Repartition of weight according to height", shape = "Family history")
With no surprise, BMI depends on Height and
Weight. We added the information about
family history, represented with the shape of the
point.
Some statistical analyses
PCA
PCA (Principal Component Analysis) is a statistical technique
which enables us to simplify complex multidimensionnal datasets by
reducing the number of variables while preserving
information.
Indeed, this method is based on transforming the original variables into
new, uncorrelated variables, called principal components, which
successively capture the greatest possible variance in the data. So, it
is often used to make data easier to explore and visualize.
We will perform a PCA in order to visualize the patients
when taking into account every numeric variable.
## 6.1
data_for_pca = obesity_without_na[,map_lgl(obesity_without_na, is.numeric)]
## 6.2
pca_res = prcomp(data_for_pca, scale = TRUE)
## 6.3
print("Here is the head of the PCA coordinates :")## [1] "Here is the head of the PCA coordinates :"head(pca_res$x)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -1.4833880 -0.3522440 -0.70065216 0.7180619 0.16048037 1.1810569
## [2,] -1.1256790 0.7533163 1.07684458 -3.0984167 0.07254866 0.8296358
## [3,] -0.6334807 1.6832944 0.60247341 0.5823536 -0.15601342 -0.4871111
## [4,] 0.6121253 0.6842018 1.49063830 -1.0252005 0.63352528 -0.6666564
## [5,] -0.1367602 -1.0759814 0.02587933 0.3317372 -1.81954242 -0.6486798
## [6,] -1.5675642 -1.3029831 1.19159441 0.3999047 0.12424497 1.3559510
## PC7 PC8 PC9
## [1,] -0.16626861 -0.003844692 0.03274228
## [2,] 0.43108038 -1.743759554 0.08418544
## [3,] 0.25573240 0.095977078 -0.05401156
## [4,] -0.06985795 0.542883721 -0.01944557
## [5,] -1.62643112 1.053804892 -0.03602851
## [6,] -0.22657870 0.312509072 0.07287356The scree plot represents the part of variance explained by each component.
## 6.4
# install.packages("factoextra")
library(factoextra)
## 6.5
fviz_eig(pca_res)
Using the elbow method, we should here keep 2 components to project individuals.
## 6.7
fviz_pca_ind(pca_res, geom = "point",
col.ind = obesity_without_na$NObeyesdad)
We projects individuals on the first plan, composed of the 2 first
components.
We colored them according to the level of obesity, and can observe that
the first component is associated with this level of
obesity, with more obese individuals on the right and
insufficient weight individuals on the left.
As reminder, this variable was not given in the construction of the
PCA.
What’s more, we can see that axes 1 and 2 explain 44.6% of the total variance.
Let’s look at the variables :
## 6.9
fviz_pca_var(pca_res)
The weight and BMI are associated with the first component.
Khi-2 test
To explore some qualitative variables, we’ll perform a \(\chi^2\) test.
A \(\chi^2\) independance test allows us to test, and possibly reject, the hypothesis of independance between two categorical variables.
This test calculates the p-value, which allows us to reject or not the independance hypothesis : if the p-value is lower than a threshold, commonly set to 0.05, we deduce that the variables are significantly associated.
You can find some explanations of this test here and here.
Note that one condition to perform this test is to have at least 5 expected individuals in each crossed group.
We want to test the link between Gender and
family history with overweight
First, we print the contingency table between both these variables :
## 7.1
table(obesity_without_na$Gender, obesity_without_na$family_history_with_overweight)##
## no yes
## Female 218 774
## Male 146 868Now we display the proportions according to the rows, so
Gender :
## 7.2
round(prop.table(
table(
obesity_without_na$Gender,
obesity_without_na$family_history_with_overweight
),
1 # To specify that we want calculate proportions on rows
), 3)##
## no yes
## Female 0.220 0.780
## Male 0.144 0.856Test
## 7.4
khi_result = chisq.test(x = obesity_without_na$Gender,
y = obesity_without_na$family_history_with_overweight)
## 7.5
print(paste("The p-value of the khi-test is", round(khi_result$p.value, 5)))## [1] "The p-value of the khi-test is 1e-05"The p-value is lower than 0.05, indicating that
Gender and family history are statistically
significantly associated at 5% threshold.
We have to check that the hypothesis is satisfied, otherwise we could
not interpret the results of the test because the khi-test
would not be appropriate.
To do so, we look at the expected counts under the null hypothesis :
khi_result$expected # To access the table of expected counts under the null hypothesis##
## obesity_without_na$Gender no yes
## Female 180.004 811.996
## Male 183.996 830.004There is no value under 5 : the hypothesis is satisfied.
Session info
We’re now at the end of the analyses. To ensure reproducibility, we would like to conserve informations about versions for every package used.
devtools::session_info()## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 4.4.2 (2024-10-31)
## os Ubuntu 20.04.6 LTS
## system x86_64, linux-gnu
## ui X11
## language (EN)
## collate fr_FR.UTF-8
## ctype fr_FR.UTF-8
## tz Europe/Paris
## date 2026-02-18
## pandoc 3.1.1 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/ (via rmarkdown)
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date (UTC) lib source
## abind 1.4-8 2024-09-12 [1] CRAN (R 4.4.1)
## backports 1.5.0 2024-05-23 [1] CRAN (R 4.4.1)
## broom 1.0.10 2025-09-13 [1] CRAN (R 4.4.2)
## bslib 0.8.0 2024-07-29 [1] CRAN (R 4.4.1)
## cachem 1.1.0 2024-05-16 [1] CRAN (R 4.4.1)
## car 3.1-3 2024-09-27 [1] CRAN (R 4.4.1)
## carData 3.0-5 2022-01-06 [1] CRAN (R 4.4.1)
## cli 3.6.5 2025-04-23 [1] CRAN (R 4.4.2)
## colorspace 2.1-1 2024-07-26 [1] CRAN (R 4.4.1)
## crosstalk 1.2.1 2023-11-23 [1] CRAN (R 4.4.1)
## devtools 2.4.5 2022-10-11 [1] CRAN (R 4.4.1)
## digest 0.6.37 2024-08-19 [1] CRAN (R 4.4.1)
## dplyr * 1.1.4 2023-11-17 [1] CRAN (R 4.4.1)
## DT * 0.33 2024-04-04 [1] CRAN (R 4.4.1)
## ellipsis 0.3.2 2021-04-29 [1] CRAN (R 4.4.1)
## evaluate 1.0.1 2024-10-10 [1] CRAN (R 4.4.1)
## factoextra * 1.0.7 2020-04-01 [1] CRAN (R 4.4.2)
## fansi 1.0.6 2023-12-08 [1] CRAN (R 4.4.1)
## farver 2.1.2 2024-05-13 [1] CRAN (R 4.4.1)
## fastmap 1.2.0 2024-05-15 [1] CRAN (R 4.4.1)
## forcats * 1.0.0 2023-01-29 [1] CRAN (R 4.4.1)
## Formula 1.2-5 2023-02-24 [1] CRAN (R 4.4.1)
## fs 1.6.5 2024-10-30 [1] CRAN (R 4.4.1)
## generics 0.1.3 2022-07-05 [1] CRAN (R 4.4.1)
## ggplot2 * 3.5.1 2024-04-23 [1] CRAN (R 4.4.1)
## ggpubr 0.6.0 2023-02-10 [1] CRAN (R 4.4.1)
## ggrepel 0.9.6 2024-09-07 [1] CRAN (R 4.4.1)
## ggsignif 0.6.4 2022-10-13 [1] CRAN (R 4.4.1)
## glue 1.8.0 2024-09-30 [1] CRAN (R 4.4.1)
## gtable 0.3.6 2024-10-25 [1] CRAN (R 4.4.1)
## hms 1.1.3 2023-03-21 [1] CRAN (R 4.4.1)
## htmltools 0.5.8.1 2024-04-04 [1] CRAN (R 4.4.1)
## htmlwidgets 1.6.4 2023-12-06 [1] CRAN (R 4.4.1)
## httpuv 1.6.15 2024-03-26 [1] CRAN (R 4.4.1)
## jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.4.1)
## jsonlite 1.8.9 2024-09-20 [1] CRAN (R 4.4.1)
## knitr 1.49 2024-11-08 [1] CRAN (R 4.4.1)
## labeling 0.4.3 2023-08-29 [1] CRAN (R 4.4.1)
## later 1.3.2 2023-12-06 [1] CRAN (R 4.4.1)
## lifecycle 1.0.4 2023-11-07 [1] CRAN (R 4.4.1)
## lubridate * 1.9.4 2024-12-08 [1] CRAN (R 4.4.2)
## magrittr 2.0.3 2022-03-30 [1] CRAN (R 4.4.1)
## memoise 2.0.1 2021-11-26 [1] CRAN (R 4.4.1)
## mime 0.12 2021-09-28 [1] CRAN (R 4.4.1)
## miniUI 0.1.1.1 2018-05-18 [1] CRAN (R 4.4.1)
## munsell 0.5.1 2024-04-01 [1] CRAN (R 4.4.1)
## pillar 1.9.0 2023-03-22 [1] CRAN (R 4.4.1)
## pkgbuild 1.4.5 2024-10-28 [1] CRAN (R 4.4.1)
## pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 4.4.1)
## pkgload 1.4.0 2024-06-28 [1] CRAN (R 4.4.1)
## profvis 0.4.0 2024-09-20 [1] CRAN (R 4.4.1)
## promises 1.3.0 2024-04-05 [1] CRAN (R 4.4.1)
## purrr * 1.0.2 2023-08-10 [1] CRAN (R 4.4.1)
## R6 2.5.1 2021-08-19 [1] CRAN (R 4.4.1)
## RColorBrewer 1.1-3 2022-04-03 [1] CRAN (R 4.4.1)
## Rcpp 1.0.13-1 2024-11-02 [1] CRAN (R 4.4.1)
## readr * 2.1.5 2024-01-10 [1] CRAN (R 4.4.2)
## remotes 2.5.0 2024-03-17 [1] CRAN (R 4.4.1)
## rlang 1.1.6 2025-04-11 [1] CRAN (R 4.4.2)
## rmarkdown 2.29 2024-11-04 [1] CRAN (R 4.4.1)
## rstatix 0.7.2 2023-02-01 [1] CRAN (R 4.4.1)
## rstudioapi 0.17.1 2024-10-22 [1] CRAN (R 4.4.2)
## sass 0.4.9 2024-03-15 [1] CRAN (R 4.4.1)
## scales 1.3.0 2023-11-28 [1] CRAN (R 4.4.1)
## sessioninfo 1.2.2 2021-12-06 [1] CRAN (R 4.4.1)
## shiny 1.9.1 2024-08-01 [1] CRAN (R 4.4.1)
## stringi 1.8.4 2024-05-06 [1] CRAN (R 4.4.1)
## stringr * 1.5.1 2023-11-14 [1] CRAN (R 4.4.1)
## tibble * 3.2.1 2023-03-20 [1] CRAN (R 4.4.1)
## tidyr * 1.3.1 2024-01-24 [1] CRAN (R 4.4.1)
## tidyselect 1.2.1 2024-03-11 [1] CRAN (R 4.4.1)
## tidyverse * 2.0.0 2023-02-22 [1] CRAN (R 4.4.2)
## timechange 0.3.0 2024-01-18 [1] CRAN (R 4.4.2)
## tzdb 0.5.0 2025-03-15 [1] CRAN (R 4.4.2)
## urlchecker 1.0.1 2021-11-30 [1] CRAN (R 4.4.1)
## usethis 3.0.0 2024-07-29 [1] CRAN (R 4.4.1)
## utf8 1.2.4 2023-10-22 [1] CRAN (R 4.4.1)
## vctrs 0.6.5 2023-12-01 [1] CRAN (R 4.4.1)
## withr 3.0.2 2024-10-28 [1] CRAN (R 4.4.1)
## xfun 0.54 2025-10-30 [1] CRAN (R 4.4.2)
## xtable 1.8-4 2019-04-21 [1] CRAN (R 4.4.1)
## yaml 2.3.10 2024-07-26 [1] CRAN (R 4.4.1)
##
## [1] /home/estelle/R/x86_64-pc-linux-gnu-library/4.4
## [2] /usr/local/lib/R/site-library
## [3] /usr/lib/R/site-library
## [4] /usr/lib/R/library
##
## ──────────────────────────────────────────────────────────────────────────────