Trabajo de Estadistica
Juan Ajiaco, Yaira Zarate y Samantha Vela
2026-04-26
DatasetE <- read.table(
"C:/Users/Juan David Ajiaco/Downloads/DatasetE.txt",
header = TRUE,
stringsAsFactors = TRUE,
sep = "\t",
na.strings = "NA",
dec = ".",
strip.white = TRUE
)
# Comprobar que la base se cargó correctamente
head(DatasetE)## Genero Edad Peso Historial_familiar_con_sobrepeso FAVC FCVC NCP
## 1 Femenino 21 64.0 Si No A veces Tres
## 2 Femenino 21 56.0 Si No Siempre Tres
## 3 Masculino 23 77.0 Si No A veces Tres
## 4 Masculino 27 87.0 No No Siempre Tres
## 5 Masculino 22 89.8 No No A veces Entre 1 y 2
## 6 Masculino 29 53.0 No Si A veces Tres
## CAEC FUMA CH2O SCC FAF TUE CALC
## 1 A veces No Entre 1 y 2L No Ninguna 3-5 horas No
## 2 A veces Si Más de 2L Si 4-5 días 0-2 horas A veces
## 3 A veces No Entre 1 y 2L No 2-4 días 3-5 horas Frecuentemente
## 4 A veces No Entre 1 y 2L No 2-4 días 0-2 horas Frecuentemente
## 5 A veces No Entre 1 y 2L No Ninguna 0-2 horas A veces
## 6 A veces No Entre 1 y 2L No Ninguna 0-2 horas A veces
## MTRANS NObeyesdad Altura IMC Superficie_Corporal
## 1 Transporte público Peso normal 1.62 24.39 1.697
## 2 Transporte público Peso normal 1.52 24.24 1.538
## 3 Transporte público Peso normal 1.80 23.77 1.962
## 4 Caminar Sobrepeso I 1.80 26.85 2.086
## 5 Transporte público Sobrepeso II 1.78 28.34 2.107
## 6 Automóvil Peso normal 1.62 20.20 1.544library(RcmdrMisc)## Cargando paquete requerido: car## Cargando paquete requerido: carData## Cargando paquete requerido: sandwichlibrary(Rcmdr)## Cargando paquete requerido: splines## Cargando paquete requerido: effects## Registered S3 method overwritten by 'lme4':
## method from
## na.action.merMod car## lattice theme set by effectsTheme()
## See ?effectsTheme for details.## The Commander GUI is launched only in interactive sessions##
## Attaching package: 'Rcmdr'## The following object is masked from 'package:base':
##
## errorConditionlibrary(car)
library(carData)
library(sandwich)
library(effects)
library(colorspace)
library(colorspace)
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()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some() masks car::some()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary("GGally")
library("corrplot")## corrplot 0.95 loadedlibrary("plotly")##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutlibrary(tidyverse)
library("cluster")
library("factoextra")## Welcome to factoextra!
## Want to learn more? See two factoextra-related books at https://www.datanovia.com/en/product/practical-guide-to-principal-component-methods-in-r/library(GGally)
library(corrplot)
library(plotly)
library(cluster)
library(factoextra)
library(cluster)
library(dplyr)
library(aplpack)
library(ggplot2)
library(knitr)Resumen
La obesidad es un problema de salud que sigue creciendo y afecta a distintos grupos, este proyecto tuvo como objetivo analizar la relación entre hábitos alimenticios, estilo de vida y la obesidad en una muestra de 104 individuos del dataset Estimation of Obesity Levels Based on Eating Habits and Physical Condition, analizando variables como la frecuencia del consumo de alimentos calóricos, número de comidas diarias, ingesta de agua, actividad física, otros comportamientos como el uso de tecnología, consumo de alcohol, tabaco y otras variables. Los resultados muestran que el alto consumo de calorías y la baja actividad física se asocian con mayores niveles de sobrepeso y obesidad, mientras que hábitos saludables como el consumo regular de agua y el ejercicio frecuente se relacionan con un menor riesgo. En conclusión, la obesidad no depende de una sola variable, sino de la combinación de varios aspectos de la vida diaria. Los resultados muestran que adoptar hábitos más saludables, como una mejor alimentación y mayor actividad física, puede ayudar en la prevención.
Introduccion
La obesidad es un problema de salud que ha aumentado bastante en los últimos años, afecta a personas de todas las edades y contextos sociales. Se ha demostrado que factores como los hábitos alimenticios y el estilo de vida influyen directamente en el desarrollo de la obesidad. Este proyecto análiza una muestra de 104 individuos obtenida del DatasetE Estimation of Obesity Levels Based on Eating Habits and Physical Condition. Se examinan variables relacionadas con la alimentación, la actividad física y otros comportamientos, para ver su relación con el nivel de obesidad. El estudio se desarrolla mediante la clasificación y analisis de las variables, lo que permite identificar relaciones relevantes. Se busca aportar una comprensión más clara de los factores asociados a la obesidad.
Pregunta Problema
¿Cómo influyen los hábitos alimenticios y el estilo de vida en el nivel de obesidad de los individuos de la muestra?
Objetivo
Analizar la relación entre los hábitos alimenticios y el estilo de vida con los niveles de obesidad en una muestra de 104 individuos, para identificar factores asociados al desarrollo de sobrepeso y obesidad.
Descripción de variables
- Genero (genero)(no numérico, nominal)
- Edad (edad/años cumplidos)(numérico, continuo)
- Altura (altura/metros)(numérico, continuo)
- Peso (peso/kilogramos)(numérico, continuo)
- Family history with overPeso (no numérico, nominal)
- FAVC (consume comida con altas calorías frecuentemente) (no numérico, nominal)
- FCVC (usualmente consume vegetales en sus comidas) (no numérico, no ordinal)
- NCP (cuantas comidas principales consume a diario) (no numérico, ordinal)
- CAEC (consume alimentos entre comidas) (no numérico, ordinal)
- FUMA (personas que fuman)(no numérico, nominal)
- CH2O (cuanta agua bebe diariamente) (no numérico, ordinal)
- SCC (monitorea las calorías consumidas a diario) (no numérico, nominal)
- FAF (que tan seguido hace actividad física) (no numérico, ordinal)
- TUE (que tan seguido usa aparatos electrónicos) (no numérico, ordinal)
- CALC (que tan seguido toma alcohol) (no numérico, ordinal)
- M trans (que medios de transporte usa) (no numérico, nominal)
- NOBEYESDAD (nivel de obesidad) (no numérico, ordinal)
Gráficos
Grafico de tallo y hoja
cat("Gráfico de tallo-hojas: Edad\n")## Gráfico de tallo-hojas: Edadstem(DatasetE$Edad)##
## The decimal point is at the |
##
## 16 | 0
## 18 | 00000
## 20 | 000000000000000000000000000000
## 22 | 000000000000000000000000000000000000
## 24 | 0000000
## 26 | 0000
## 28 | 0000
## 30 | 0000000
## 32 |
## 34 | 000
## 36 |
## 38 | 00
## 40 | 00
## 42 |
## 44 | 0
## 46 |
## 48 |
## 50 |
## 52 | 0
## 54 | 0cat("Gráfico de tallo-hojas: Peso\n")## Gráfico de tallo-hojas: Pesostem(DatasetE$Peso)##
## The decimal point is 1 digit(s) to the right of the |
##
## 4 | 4
## 4 | 5555899
## 5 | 0002233
## 5 | 5555556678889
## 6 | 000000000022223444
## 6 | 555556778889
## 7 | 0002222
## 7 | 556677889
## 8 | 000000022234
## 8 | 556778
## 9 | 000014
## 9 | 59
## 10 | 2
## 10 | 5
## 11 | 2
## 11 |
## 12 |
## 12 |
## 13 | 0cat("Gráfico de tallo-hojas: Altura\n")## Gráfico de tallo-hojas: Alturastem(DatasetE$Altura)##
## The decimal point is 2 digit(s) to the left of the |
##
## 150 | 0000
## 152 | 0000
## 154 | 000
## 156 | 0
## 158 | 0
## 160 | 000000000
## 162 | 000000000
## 164 | 0000000000000000000
## 166 | 00000000
## 168 | 0000000
## 170 | 000000
## 172 | 0000
## 174 | 00000
## 176 | 000000
## 178 | 000
## 180 | 0000000
## 182 | 00
## 184 | 000
## 186 |
## 188 | 0
## 190 |
## 192 | 00cat("Grafico de tallo-hojas: IMC\n")## Grafico de tallo-hojas: IMCstem(DatasetE$IMC)##
## The decimal point is at the |
##
## 16 | 9
## 17 | 6689
## 18 | 58
## 19 | 022355679
## 20 | 122346778
## 21 | 0033555788
## 22 | 000035556788
## 23 | 02588
## 24 | 22234446688
## 25 | 78
## 26 | 345799
## 27 | 01247788
## 28 | 011379
## 29 | 00444444
## 30 | 5677
## 31 | 1
## 32 | 0
## 33 | 13
## 34 | 9
## 35 | 3
## 36 | 2cat("Grafico de tallo-hojas: Superficie_Corporal\n")## Grafico de tallo-hojas: Superficie_Corporalstem(DatasetE$Superficie_Corporal)##
## The decimal point is 1 digit(s) to the left of the |
##
## 13 | 58
## 14 | 11356679
## 15 | 12244456688
## 16 | 00122333455666667799
## 17 | 002222335556789
## 18 | 01223777779
## 19 | 111222223456678899
## 20 | 012234799
## 21 | 12233
## 22 | 3
## 23 | 244
## 24 |
## 25 |
## 26 | 3Edad: concentración fuerte en los 20 años, con pocos casos en edades mayores. Peso: mayor distribución entre 50–80 kg, pero también casos extremos hacia 40 y 100 kg. Altura: gran concentración alrededor de 160–165 cm, baja dispersión.
Graficos de pastel y barras
Graficos IMC
# Clasificar el IMC
IMC_cat <- cut(DatasetE$IMC,
breaks = c(0, 18.5, 25, 30, Inf),
labels = c("Bajo peso", "Normal",
"Sobrepeso", "Obesidad"),
right = FALSE)
# Frecuencias
tabla_IMC <- table(IMC_cat)
# Pastel
piechart(tabla_IMC,
main = "Clasificación del IMC",
col = rainbow_hcl(4),
scale = "percent")
IMC_cat <- cut(DatasetE$IMC,
breaks = c(0,18.5,25,30,Inf),
labels = c("Bajo peso","Normal","Sobrepeso","Obesidad"),
right = FALSE)
tabla_IMC <- table(IMC_cat)
barplot(tabla_IMC,
main = "Clasificación del IMC",
xlab = "Categoría",
ylab = "Frecuencia",
col = rainbow(4))
Graficos superficie corporal
SC_cat <- cut(DatasetE$Superficie_Corporal,
breaks = seq(floor(min(DatasetE$Superficie_Corporal)*10)/10,
ceiling(max(DatasetE$Superficie_Corporal)*10)/10,
by = 0.2),
include.lowest = TRUE)
tabla_SC <- table(SC_cat)
piechart(tabla_SC,
main = "Superficie Corporal",
col = rainbow_hcl(length(tabla_SC)),
scale = "percent")
SC_cat <- cut(DatasetE$Superficie_Corporal,
breaks = seq(floor(min(DatasetE$Superficie_Corporal)*10)/10,
ceiling(max(DatasetE$Superficie_Corporal)*10)/10,
by = 0.2),
include.lowest = TRUE)
tabla_SC <- table(SC_cat)
barplot(tabla_SC,
main = "Distribución de la Superficie Corporal",
xlab = "Superficie Corporal (m²)",
ylab = "Frecuencia",
col = rainbow(length(tabla_SC)),
las = 2)
Gráficos que muestran el conteo y porcentaje total de hombres y mujeres
with(DatasetE, piechart(Genero, xlab="", ylab="", main="Genero", col=rainbow_hcl(2), scale="percent", ))
with(DatasetE, Barplot(Genero, xlab="Genero", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de, barras: La distribución se preseenta asi: 54 hombres y 50 mujeres.
Gráfico de pastel: Esto corresponde a 52% hombres y 48% mujeres.
Existe una ligera predominancia masculina. La muestra está relativamente balanceada en términos de género.
Gráficos que muestran el conteo y porcentaje total de personas con historial de sobre peso en familiares
with(DatasetE, piechart(Historial_familiar_con_sobrepeso, scale ="percent", main="Historial_familiar_con_sobrepeso"))
with(DatasetE, Barplot(Historial_familiar_con_sobrepeso, xlab="Historial_familiar_con_sobrepeso", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 76 individuos tienen antecedentes familiares de sobrepeso, mientras que 28 no.
Gráfico de pastel: 73% “sí” frente a 27% “no”.
La mayoría tienen predisposición familiar al sobrepeso, lo cual puede ser relevante en el análisis del estado nutricional.
Gráficos que muestran el conteo y porcentaje total de personas que consumen comidas en altas calorias frecuentemente
with(DatasetE, piechart(FAVC, xlab="", ylab="", main="FAVC",
col=palette()[2:3], scale="percent"))
with(DatasetE, Barplot(FAVC, xlab="FAVC", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 63 personas consumen frecuentemente alimentos altos en calorías, mientras que 41 no.
Gráfico de pastel: 61% “sí” frente a 39% “no”.
Predomina el hábito de consumir alimentos calóricos, lo que podría influir directamente en el estado nutricional y el riesgo de sobrepeso.
Gráficos que muestran el conteo y porcentaje total de personas que consumen vegetales frecuentemente en sus comidas
with(DatasetE, piechart(FCVC, xlab="", ylab="", main="FCVC",
col=palette()[2:4], scale="percent"))
with(DatasetE, Barplot(FCVC, xlab="FCVC", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: La categoría más frecuente es “algunas veces” con 64 individuos, seguida de “siempre” con 31, y un grupo reducido en “never”.
Gráfico de pastel: 62% “a veces”, 30% “siempre” y 9% “nunca”.
Aunque la mayoría consume vegetales ocasionalmente, no es un hábito en toda la población, siendo un consumo insuficiente para algunos.
Gráficos que muestran el conteo y porcentaje total de cuantas comidas principales come al dia
with(DatasetE, piechart(NCP, xlab="", ylab="", main="NCP",
col=palette()[2:4], scale="percent"))
with(DatasetE, Barplot(NCP, xlab="NCP", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: La mayoría (78 individuos) consume tres comidas principales, seguido de 17 que consumen entre 1 y 2, y unos pocos más de tres.
Gráfico de pastel: Un 75% para “tres”, 16% para “entre 1 y 2” y 9% para “más de tres”.
Lo mas comun son las tres comidas diarias, siendo asi en la mayoria de la muestra.
Gráficos que muestran el conteo y porcentaje de personas que consumen alimentos entre comidas
with(DatasetE, piechart(CAEC, xlab="", ylab="", main="CAEC", col=palette()[2:5],
scale="percent"))
with(DatasetE, Barplot(CAEC, xlab="CAEC", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: La categoría más frecuente es “algunas veces” con 65 individuos, seguida de “frecuentemente” con 23, “siempre” con 9 y “no” con 7.
Gráfico de pastel: Esto corresponde a 62% “a veces”, 22% “frecuentemente”, 9% “siempre” y 7% “no”.
La mayoría de los participantes tienden a comer entre comidas ocasionalmente, lo que indica un hábito moderado de picar alimentos fuera de los horarios principales.
Gráficos que muestran el conteo y porcentaje de personas que fuman
with(DatasetE, piechart(FUMA, xlab="", ylab="", main="FUMA",
col=palette()[2:3], scale="percent"))
with(DatasetE, Barplot(FUMA, xlab="FUMA", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 94 individuos no fuman, mientras que una minoría sí lo hace.
Gráfico de pastel: 90% “no” frente a 10% “sí”.
Fumar es poco común en la muestra, predominando claramente los no fumadores.
Gráficos que muestran el conteo y porcentaje total de agua que consumen diariamente
with(DatasetE, piechart(CH2O, xlab="", ylab="", main="CH2O", col=palette()[2:4],
scale="percent"))
with(DatasetE, Barplot(CH2O, xlab="CH2O", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 64 personas consumen entre 1 y 2 litros, 24 más de 2 litros y 16 menos de un litro.
Gráfico de pastel: 62% “entre 1 y 2 L”, 23% “más de 2 L” y 15% “menos de 1 L”.
La mayoría mantiene un consumo moderado, aunque un grupo no tan grande supera los 2 litros, lo cual es positivo para la salud.
Gráficos que muestran el conteo y porcentaje total de personas que monitorean las calorias en sus comidas principales
with(DatasetE, piechart(SCC, xlab="", ylab="", main="SCC", col=palette()[2:3],
scale="percent"))
with(DatasetE, Barplot(SCC, xlab="SCC", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 91 individuos no monitorean sus calorías, mientras que una minoría sí lo hace.
Gráfico de pastel: 88% “no” frente a 12% “sí”.
El monitoreo de calorías es poco frecuente en la muestra, lo que puede influir en el cuiddao del peso.
Gráficos que muestran el conteo y porcentaje de los intervalos de tiempo en el que realizan actividad fisica
with(DatasetE, piechart(FAF, xlab="", ylab="", main="FAF", col=palette()[2:5],
scale="percent"))
with(DatasetE, Barplot(FAF, xlab="FAF", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 41 personas no realizan actividad física, 24 lo hacen 1–2 días, 30 lo hacen 2–4 días y 9 lo hacen 4–5 días.
Gráfico de pastel: 39% “no tengo”, 23% “1–2 días”, 29% “2–4 días” y 9% “4–5 días”.
La mayor parte de la muestra no realiza actividad física, aunque también hay un grupo que mantiene cierta actividad.
Gráficos que muestran el conteo y porcentaje de los intervalos de tiempo en el que usan dispositivos tecnologicos
with(DatasetE, piechart(TUE, xlab="", ylab="", main="TUE", col=palette()[2:4],
scale="percent"))
with(DatasetE, Barplot(TUE, xlab="TUE", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 53 personas usan entre 0–2 horas, 38 entre 3–5 horas y 13 más de 5 horas.
Gráfico de pastel: 51% “0–2 horas”, 37% “3–5 horas” y 12% “más de 5 horas”.
El uso moderado de dispositivos tiene mayor frecuencia, aunque tambien un grupo pasa más de 3 horas al día en ellos.
Gráficos que muestran el conteo y porcentajes totales de la frecuencia con la que consumen alcohol
with(DatasetE, piechart(CALC, xlab="", ylab="", main="CALC", col=palette()[2:5],
scale="percent"))
with(DatasetE, Barplot(CALC, xlab="CALC", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 56 “algunas veces”, 36 “no”, 11 “frecuentemente” y un valor mínimo en “siempre”.
Gráfico de pastel: 54% “a veces”, 35% “no”, 11% “frecuentemente” y 1% “siempre”.
El consumo ocasional de alcohol es lo más común, mientras que el consumo frecuente o diario es muy poco.
Gráficos que muestran el conteo y porcentajes totales del medio de transporte que utilizan los individuos
with(DatasetE, piechart(MTRANS, xlab="", ylab="", main="MTRANS",
col=palette()[2:6], scale="percent",cex=0.8 ))
legend("topleft",
legend = levels(DatasetE$MTRANS),
fill = palette()[2:6],
cex = 0.8,
bty = "n")
with(DatasetE, Barplot(MTRANS, xlab="MTRANS", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de barras: 65 usan transporte público, 24 automóvil, 13 caminan, y muy pocos usan bicicleta o moto.
Gráfico de pastel: 62% transporte público, 23% automóvil, 12% caminata, 2% moto y 2% bicicleta.
El transporte público es el medio de trasporte mas usado, seguido por el automóvil, hábitos urbanos típicos.
Gráficos que muestran el conteo y porcentajes totales del rango de peso de cada individuo
with(DatasetE, piechart(NObeyesdad, xlab="", ylab="", main="NObeyesdad",
col=palette()[2:6], scale="percent"))
legend("topright", legend=levels(DatasetE$NObeyesdad),
fill=palette()[2:6], cex=0.8, bty="n",)
with(DatasetE, Barplot(NObeyesdad, xlab="NObeyesdad", ylab="Frequency",
label.bars=TRUE, axes=FALSE))
Gráfico de pastel: 56% Peso Normal, 5% Peso Insuficiente, 21% Sobrepeso nivel 2, 8% Sobrepeso nivel 2 y 9% Obesidad tipo 1.
Gráfico de barras: Lo más frecuente es el Peso Normal, seguida de Sobrepeso nivel 2 y Obesidad tipo 1.
Aunque la mayoría presenta peso normal, existe una proporción considerable con sobrepeso y obesidad, lo que muestra la relevancia del estudio.
Tablas cruzadas
Usualmente consume vegetales en sus comidas / Monitorea las calorias consumidas a diario
.Table <- xtabs(~ FCVC + SCC, data = DatasetE)
cat("\nTabla de frecuencias:\n")##
## Tabla de frecuencias:print(.Table)## SCC
## FCVC No Si
## A veces 61 3
## Nunca 8 1
## Siempre 22 9cat("\nPorcentajes por filas:\n")##
## Porcentajes por filas:row_perc <- prop.table(.Table, 1)
print(round(row_perc * 100, 2))## SCC
## FCVC No Si
## A veces 95.31 4.69
## Nunca 88.89 11.11
## Siempre 70.97 29.03cat("\nPorcentajes por columnas:\n")##
## Porcentajes por columnas:col_perc <- prop.table(.Table, 2)
print(round(col_perc * 100, 2))## SCC
## FCVC No Si
## A veces 67.03 23.08
## Nunca 8.79 7.69
## Siempre 24.18 69.23colores <- c("red", "orange", "lightblue", "purple")
par(mar = c(5, 4, 4, 10))
barplot(t(row_perc),
col = colores,
border = "black",
main = "Proporciones por filas (FCVC vs SCC)",
xlab = "FCVC",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = colnames(row_perc),
fill = colores,
bty = "n",
xpd = TRUE)
barplot(col_perc,
col = colores,
border = "black",
main = "Proporciones por columnas (FCVC vs SCC)",
xlab = "SCC",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = rownames(col_perc),
fill = colores,
bty = "n",
xpd = TRUE)
Tabla de frecuencias: Quienes siempre consumen vegetales: 22 no monitorean calorías y 9 sí. Quienes nunca consumen vegetales: 8 no monitorean y 1 sí. Quienes consumen vegetales a veces: 61 no monitorean y 3 sí.
Porcentajes por filas: “Siempre”: 71% no monitorean, 29% sí. “Never”: 89% no, 11% sí. “Algunas veces”: 95% no, 5% sí.
Aunque los que consumen vegetales con mayor frecuencia, en su mayoría monitorear más sus calorías, en general el control calórico es bajo en todos los grupos.
Cuantas comidas principales consume a diario / Consume alimentos entre comidas
.Table <- xtabs(~ NCP + CAEC, data = DatasetE)
cat("\nTabla de frecuencias:\n")##
## Tabla de frecuencias:print(.Table)## CAEC
## NCP A veces Frecuentemente Nunca Siempre
## Entre 1 y 2 14 2 0 1
## Más de tres 1 7 0 1
## Tres 50 14 7 7cat("\nPorcentajes por filas:\n")##
## Porcentajes por filas:row_perc <- prop.table(.Table, 1)
print(round(row_perc * 100, 2))## CAEC
## NCP A veces Frecuentemente Nunca Siempre
## Entre 1 y 2 82.35 11.76 0.00 5.88
## Más de tres 11.11 77.78 0.00 11.11
## Tres 64.10 17.95 8.97 8.97cat("\nPorcentajes por columnas:\n")##
## Porcentajes por columnas:col_perc <- prop.table(.Table, 2)
print(round(col_perc * 100, 2))## CAEC
## NCP A veces Frecuentemente Nunca Siempre
## Entre 1 y 2 21.54 8.70 0.00 11.11
## Más de tres 1.54 30.43 0.00 11.11
## Tres 76.92 60.87 100.00 77.78colores <- c("red", "orange", "lightblue", "purple")
par(mar = c(5, 4, 4, 10))
barplot(t(row_perc),
col = colores,
border = "black",
main = "Proporciones por filas (NCP vs CAEC)",
xlab = "NCP",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = colnames(row_perc),
fill = colores,
bty = "n",
xpd = TRUE)
barplot(col_perc,
col = colores,
border = "black",
main = "Proporciones por columnas (NCP vs CAEC)",
xlab = "CAEC",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = rownames(col_perc),
fill = colores,
bty = "n",
xpd = TRUE)
Tabla de frecuencias: Quienes comen tres comidas: 50 “algunas veces”, 14 “frecuentemente”, 7 “siempre” y 7 “no”. Quienes comen entre 1 y 2 comidas: 14 “algunas veces”, 2 “frecuentemente”, 1 “siempre”.
Porcentajes por filas: “Tres comidas”: 64% a veces comen entre comidas, 18% frecuentemente, 9% siempre, 9% nunca. “Entre 1 y 2”: 82% a veces, 12% frecuentemente, 6% siempre.
Lo más común es comer entre comidas “a veces”, mayormente en quienes mantienen tres comidas principales.
Cuanta agua bebe diariamente / Que tan seguido toma alcohol
.Table <- xtabs(~ CH2O + CALC, data = DatasetE)
cat("\nTabla de frecuencias:\n")##
## Tabla de frecuencias:print(.Table)## CALC
## CH2O A veces Frecuentemente No Siempre
## Entre 1 y 2L 34 10 19 1
## Más de 2L 14 1 9 0
## Menos de 1L 8 0 8 0cat("\nPorcentajes por filas:\n")##
## Porcentajes por filas:row_perc <- prop.table(.Table, 1)
print(round(row_perc * 100, 2))## CALC
## CH2O A veces Frecuentemente No Siempre
## Entre 1 y 2L 53.12 15.62 29.69 1.56
## Más de 2L 58.33 4.17 37.50 0.00
## Menos de 1L 50.00 0.00 50.00 0.00cat("\nPorcentajes por columnas:\n")##
## Porcentajes por columnas:col_perc <- prop.table(.Table, 2)
print(round(col_perc * 100, 2))## CALC
## CH2O A veces Frecuentemente No Siempre
## Entre 1 y 2L 60.71 90.91 52.78 100.00
## Más de 2L 25.00 9.09 25.00 0.00
## Menos de 1L 14.29 0.00 22.22 0.00colores <- c("red", "orange", "lightblue", "purple")
par(mar = c(5, 4, 4, 10))
barplot(t(row_perc),
col = colores,
border = "black",
main = "Proporciones por filas (CH2O vs CALC)",
xlab = "CH2O",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = colnames(row_perc),
fill = colores,
bty = "n",
xpd = TRUE)
barplot(col_perc,
col = colores,
border = "black",
main = "Proporciones por columnas (CH2O vs CALC)",
xlab = "CALC",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = rownames(col_perc),
fill = colores,
bty = "n",
xpd = TRUE)
Tabla de frecuencias: Quienes beben entre 1 y 2 L de agua: 34 “algunas veces” alcohol, 19 “no”, 10 “frecuentemente”, 1 “siempre”. Quienes beben menos de 1 L: mitad “no” y mitad “algunas veces”. Quienes beben más de 2 L: predominan “algunas veces” (14) y “no” (9).
Porcentajes por filas: Entre 1 y 2 L”: 53% alcohol “algunas veces”, 30% “no”. “Menos de 1 L”: 50% “no”, 50% “algunas veces”. “Más de 2 L”: 58% “algunas veces”, 38% “no”.
El consumo ocasional de alcohol es el más frecuente en todos los niveles del consumo de agua, aunque quienes beben menos de 1 L estan entre “no” y “algunas veces”.
Que tan seguido hace actividad fisica / Que tan seguido usa aparatos electronicos
.Table <- xtabs(~ FAF + TUE, data = DatasetE)
cat("\nTabla de frecuencias:\n")##
## Tabla de frecuencias:print(.Table)## TUE
## FAF 0-2 horas 3-5 horas Más de 5 horas
## 1-2 días 13 9 2
## 2-4 días 13 12 5
## 4-5 días 4 3 2
## Ninguna 23 14 4cat("\nPorcentajes por filas:\n")##
## Porcentajes por filas:row_perc <- prop.table(.Table, 1)
print(round(row_perc * 100, 2))## TUE
## FAF 0-2 horas 3-5 horas Más de 5 horas
## 1-2 días 54.17 37.50 8.33
## 2-4 días 43.33 40.00 16.67
## 4-5 días 44.44 33.33 22.22
## Ninguna 56.10 34.15 9.76cat("\nPorcentajes por columnas:\n")##
## Porcentajes por columnas:col_perc <- prop.table(.Table, 2)
print(round(col_perc * 100, 2))## TUE
## FAF 0-2 horas 3-5 horas Más de 5 horas
## 1-2 días 24.53 23.68 15.38
## 2-4 días 24.53 31.58 38.46
## 4-5 días 7.55 7.89 15.38
## Ninguna 43.40 36.84 30.77colores <- c("red", "orange", "lightblue", "purple")
par(mar = c(5, 4, 4, 10))
barplot(t(row_perc),
col = colores,
border = "black",
main = "Proporciones por filas (FAF vs TUE)",
xlab = "FAF",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = colnames(row_perc),
fill = colores,
bty = "n",
xpd = TRUE)
barplot(col_perc,
col = colores,
border = "black",
main = "Proporciones por columnas (FAF vs TUE)",
xlab = "TUE",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = rownames(col_perc),
fill = colores,
bty = "n",
xpd = TRUE)
Tabla de frecuencias: Quienes hacen 1–2 días de actividad física: 13 usan 0–2 horas de tecnología, 9 usan 3–5 horas y 2 más de 5 horas. Quienes hacen 2–4 días: 13 usan 0–2 horas, 12 usan 3–5 horas y 5 más de 5 horas. Quienes hacen 4–5 días: 4 usan 0–2 horas, 3 usan 3–5 horas y 2 más de 5 horas. Quienes no realizan actividad física: 23 usan 0–2 horas, 14 usan 3–5 horas y 4 más de 5 horas.
Porcentajes por filas: “No tengo”: 56% usan 0–2 horas, 34% 3–5 horas, 10% más de 5. “2–4 días”: 43% usan 0–2 horas, 40% 3–5 horas, 17% más de 5. “4–5 días”: 44% usan 0–2 horas, 33% 3–5 horas, 22% más de 5.
La mayoría de los grupos usan moderadamente dispositivos, sin embargo, quienes realizan más actividad física muestran mayor uso, más de 5 horas, lo que sugiere que la práctica de ejercicio no necesariamente reduce el tiempo frente a pantallas.
Consume comidas con altas calorias frecuentemente / Nivel de obesidad
.Table <- xtabs(~ FAVC + NObeyesdad, data = DatasetE)
cat("\nTabla de frecuencias:\n")##
## Tabla de frecuencias:print(.Table)## NObeyesdad
## FAVC Bajo peso Obesidad I Obesidad II Peso normal Sobrepeso I Sobrepeso II
## No 4 0 1 24 3 9
## Si 1 9 1 34 5 13cat("\nPorcentajes por filas:\n")##
## Porcentajes por filas:row_perc <- prop.table(.Table, 1)
print(round(row_perc * 100, 2))## NObeyesdad
## FAVC Bajo peso Obesidad I Obesidad II Peso normal Sobrepeso I Sobrepeso II
## No 9.76 0.00 2.44 58.54 7.32 21.95
## Si 1.59 14.29 1.59 53.97 7.94 20.63cat("\nPorcentajes por columnas:\n")##
## Porcentajes por columnas:col_perc <- prop.table(.Table, 2)
print(round(col_perc * 100, 2))## NObeyesdad
## FAVC Bajo peso Obesidad I Obesidad II Peso normal Sobrepeso I Sobrepeso II
## No 80.00 0.00 50.00 41.38 37.50 40.91
## Si 20.00 100.00 50.00 58.62 62.50 59.09colores <- c("red", "orange", "lightblue", "purple", "pink", "cyan")
par(mar = c(5, 4, 4, 10))
barplot(t(row_perc),
col = colores,
border = "black",
main = "Proporciones por filas (FAVC vs NObeyesdad)",
xlab = "FAVC",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = colnames(row_perc),
fill = colores,
bty = "n",
xpd = TRUE)
barplot(col_perc,
col = colores,
border = "black",
main = "Proporciones por columnas (FAVC vs NObeyesdad)",
xlab = "NObeyesdad",
ylab = "Proporción")
legend("right",
inset = c(-0.32, 0),
legend = rownames(col_perc),
fill = colores,
bty = "n",
xpd = TRUE)
Tabla de frecuencias: Entre quienes no consumen comida calórica frecuente: predominan Peso Normal (24) y Sobrepeso nivel 2 (9), con muy baja obesidad. Entre quienes sí consumen comida calórica frecuente: predominan Peso Normal (34), Obesidad tipo 1 (9) y Sobrepeso nivel 2 (13). Porcentajes por filas: “No”: 59% peso normal, 22% sobrepeso nivel II, 10% insuficiente peso, casi nula obesidad. “si”: 54% peso normal, 14% obesidad tipo I, 21% sobrepeso nivel II.
Porcentajes por columnas: En Peso Normal, 41% provienen de “no” y 59% de “sí”. En Obesidad tipo 1, todos los casos (100%) provienen de quienes consumen comida calórica frecuente. En Sobrepeso nivel 2, 59% provienen de “sí” y 41% de “no”.
El consumo frecuente de comidas calóricas está muy relacionado con la obesidad y sobrepeso. Mientras que quienes no lo hacen mantienen un peso normal, los que sí lo hacen tienen los casos de obesidad tipo I y una mayor frecuencia de sobrepeso nivel II.
Histogramas
Histograma IMC
with(DatasetE, Hist(IMC, scale="frequency", breaks="Sturges",
col="lightyellow"))
## Histograma Superficie Corporal
with(DatasetE, Hist(Superficie_Corporal, scale="frequency", breaks="Sturges",
col="orange"))
Histograma de Edad (Edad)
with(DatasetE, Hist(Edad, scale="frequency", breaks="Sturges",
col="lightblue"))
Histograma de Altura (Altura)
with(DatasetE, Hist(Altura, scale ="frequency", breaks ="Sturges",
col="lightgreen"))
Histograma de Peso (Peso)
with(DatasetE, Hist(Peso, scale ="frequency", breaks = "Sturges", col="lightpink"))
Medidas de forma de los histogramas
numSummary(DatasetE[,c("Edad", "Altura", "Peso", "IMC", "Superficie_Corporal"), drop=FALSE],
statistics=c("mean","var", "skewness", "kurtosis"),
quantiles=c(0,.25,.5,.75,1), type="2")## mean var skewness kurtosis n
## Edad 24.644231 43.22171397 2.4816320 7.04438918 104
## Altura 1.679615 0.00882121 0.3441853 -0.05581808 104
## Peso 69.517308 254.66319268 0.8322144 1.07991323 104
## IMC 24.488558 19.22065906 0.4888001 -0.41455167 104
## Superficie_Corporal 1.792442 0.05657188 0.6019441 0.56047054 104Edad (Edad)
Media (24.64): La edad promedio de la muestra son jóvenes adultos, lo que coincide con lo que se observa en el histograma, se concentra alrededor de los 20–22 años.
Varianza (43.22): Alta, lo que indica dispersión en los datos: aunque la mayoría son jóvenes, hay casos que llegan hasta los 55 años.
Asimetría (2.48): Positiva, la distribución está hacia la derecha, con mas valores bajos (jóvenes) y pocos casos altos en edades mayores.
Curtosis (7.04): Elevada, la distribución es “picuda”, lo que significa que la mayoría se concentra en un rango de juventud, pero tambien existen valores de edad altos. Presenta una curtosis leptocúrtica.
Altura (Altura)
Media (1.68 m): La altura promedio es típica de adultos jóvenes, lo que coincide con el histograma centrado en 1.60–1.70 m.
Varianza (0.0088): Baja, indica que los valores están muy concentrados alrededor de la media, con poca dispersión.
Asimetría (0.34): Positiva, la distribución es casi simétrica, pero tiene una tendencia a alturas de mayor medida.
Curtosis (-0.05): Cercana a 0, la distribución no muestra picos extremos. Presenta una curtosis platicúrtica.
Peso (Peso)
Media (69.52 kg): En el histograma se muestra concentración entre 50–80 kg, y el promedio se ubica cerca de los 70 kg.
Varianza (254.66): Alta porque deja ver gran dispersión, con individuos que llegan hasta 130 kg.
Asimetría (0.83): Positiva, la distribución está mas hacia la derecha, por algunos casos de peso elevado.
Curtosis (1.08): Moderada, la distribución presenta dispersión y es puntuiagudo . Presenta una curtosis leptocúrtica.
Resumen de datos
summary(DatasetE)## Genero Edad Peso
## Femenino :50 Min. :17.00 Min. : 44.00
## Masculino:54 1st Qu.:21.00 1st Qu.: 58.00
## Median :22.00 Median : 66.50
## Mean :24.64 Mean : 69.52
## 3rd Qu.:24.25 3rd Qu.: 80.00
## Max. :55.00 Max. :130.00
## Historial_familiar_con_sobrepeso FAVC FCVC NCP
## No:28 No:41 A veces:64 Entre 1 y 2:17
## Si:76 Si:63 Nunca : 9 Más de tres: 9
## Siempre:31 Tres :78
##
##
##
## CAEC FUMA CH2O SCC FAF
## A veces :65 No:94 Entre 1 y 2L:64 No:91 1-2 días:24
## Frecuentemente:23 Si:10 Más de 2L :24 Si:13 2-4 días:30
## Nunca : 7 Menos de 1L :16 4-5 días: 9
## Siempre : 9 Ninguna :41
##
##
## TUE CALC MTRANS
## 0-2 horas :53 A veces :56 Automóvil :24
## 3-5 horas :38 Frecuentemente:11 Bicicleta : 1
## Más de 5 horas:13 No :36 Caminar :12
## Siempre : 1 Moto : 2
## Transporte público:65
##
## NObeyesdad Altura IMC Superficie_Corporal
## Bajo peso : 5 Min. :1.500 Min. :16.94 Min. :1.354
## Obesidad I : 9 1st Qu.:1.627 1st Qu.:21.02 1st Qu.:1.627
## Obesidad II : 2 Median :1.660 Median :23.98 Median :1.757
## Peso normal :58 Mean :1.680 Mean :24.49 Mean :1.792
## Sobrepeso I : 8 3rd Qu.:1.750 3rd Qu.:27.77 3rd Qu.:1.950
## Sobrepeso II:22 Max. :1.930 Max. :36.16 Max. :2.633Edad (Edad) Rango: 17 – 55 años Media: 24.64 años Mediana: 22 años
Altura (Altura) Rango: 1.50 – 1.93 m Media: 1.68 m Mediana: 1.66 m
Peso (Peso) Rango: 44 – 130 Media: 69.52 kg Mediana: 66.5 kg
Genero: moda = masculino (54 casos).
Historial_familiar_con_sobrepeso: moda = si (76).
FAVC: moda = si (63).
FCVC: moda = algunas veces (64).
NCP: moda = tres (78).
CAEC: moda = algunas veces (66).
FUMA: moda = no (94).
CH2O: moda = entre una y dos (64).
SCC: moda = no (91).
FAF: moda = no tengo(41).
TUE: moda = 0–2 horas (53). CALC: moda = algunas veces (56).
MTRANS: moda = transporte público (65).
NObeyesdad: moda = peso normal (58).
Media Recortada
cat("Media recortada y Media (10%) de Edad\n\n")## Media recortada y Media (10%) de Edadmean(DatasetE$Edad, trim = 0.1)## [1] 23.30952mean(DatasetE$Edad)## [1] 24.64423cat("Media recortada y Media (10%) de Peso\n\n")## Media recortada y Media (10%) de Pesomean(DatasetE$Peso, trim = 0.1)## [1] 68.47381mean(DatasetE$Peso)## [1] 69.51731cat("Media recortada y Media (10%) de Altura\n\n")## Media recortada y Media (10%) de Alturamean(DatasetE$Altura, trim = 0.1)## [1] 1.677619mean(DatasetE$Altura)## [1] 1.679615cat("Media recortada y Media (10%) de IMC\n\n")## Media recortada y Media (10%) de IMCmean(DatasetE$IMC, trim = 0.1)## [1] 24.24667mean(DatasetE$IMC)## [1] 24.48856cat("Media recortada y Media (10%) de Superficie_Corporal\n\n")## Media recortada y Media (10%) de Superficie_Corporalmean(DatasetE$Superficie_Corporal, trim = 0.1)## [1] 1.781274mean(DatasetE$Superficie_Corporal)## [1] 1.792442Los resultados muestran que las medias recortadas son menores que la medias en Edad y Peso, lo que muestra la existencia de algunos valores atípicos que influyen en el comportamiento del grupo en conjunto, a diferencia de lo que sucede en la altura, la cual muestra que ambas medidas son muy cercanas entre si.
MEDA y MAD
mad(DatasetE$Peso, na.rm = TRUE)## [1] 17.0499mad(DatasetE$Altura, na.rm = TRUE)## [1] 0.088956mad(DatasetE$Edad, na.rm = TRUE)## [1] 1.4826mad(DatasetE$IMC, na.rm = TRUE)## [1] 4.959297mad(DatasetE$Superficie_Corporal, na.rm = TRUE)## [1] 0.2342508mean(abs(DatasetE$Peso - mean(DatasetE$Peso, na.rm = TRUE)))## [1] 12.87507mean(abs(DatasetE$Altura - mean(DatasetE$Altura, na.rm = TRUE)))## [1] 0.07399408mean(abs(DatasetE$Edad - mean(DatasetE$Edad, na.rm = TRUE)))## [1] 4.485577mean(abs(DatasetE$IMC - mean(DatasetE$Edad, na.rm = TRUE)))## [1] 3.682559mean(abs(DatasetE$Superficie_Corporal - mean(DatasetE$Edad, na.rm = TRUE)))## [1] 22.85179Peso: (MAD: 12.9 / MEDA:17.0) El peso varía bastante entre personas. Es una variable muy dispersa. Altura: (MAD: 0.07 / MEDA: 0.09) Las alturas son muy similares, casi no cambian entre individuos. Edad: (MAD: 4.5 / MEDA: 1.5) Hay cierta variación en edades, pero la mayoría se concentra en jóvenes adultos.
Desviacion Estandar
sd(DatasetE$Peso, na.rm = TRUE)## [1] 15.95817sd(DatasetE$Altura, na.rm = TRUE)## [1] 0.0939213sd(DatasetE$Edad, na.rm = TRUE)## [1] 6.574322sd(DatasetE$IMC, na.rm = TRUE)## [1] 4.384137sd(DatasetE$Superficie_Corporal, na.rm = TRUE)## [1] 0.2378484Peso: 15.96, muestra una alta dispersión, se notan diferencias entre individuos. Altura: 0.094, muestra baja dispersión, la mayoría tiene alturas similares. Edad: 6.57, muestra dispersión moderada, no se nota tanta diferencia entre los individuos.
Coeficiente de variacion
cat("Coeficiente de variación - Peso\n")## Coeficiente de variación - Pesocv_peso <- sd(DatasetE$Peso, na.rm = TRUE) / mean(DatasetE$Peso, na.rm = TRUE)
print(cv_peso)## [1] 0.2295568cat("Coeficiente de variación - Altura\n")## Coeficiente de variación - Alturacv_altura <- sd(DatasetE$Altura, na.rm = TRUE) / mean(DatasetE$Altura, na.rm = TRUE)
print(cv_altura)## [1] 0.05591834cat("Coeficiente de variación - Edad\n")## Coeficiente de variación - Edadcv_edad <- sd(DatasetE$Edad, na.rm = TRUE) / mean(DatasetE$Edad, na.rm = TRUE)
print(cv_edad)## [1] 0.2667692cat("Coeficiente de variación - IMC\n")## Coeficiente de variación - IMCcv_imc <- sd(DatasetE$IMC, na.rm = TRUE) / mean(DatasetE$IMC, na.rm = TRUE)
print(cv_imc)## [1] 0.179028cat("Coeficiente de variación - Superficie_Corporal\n")## Coeficiente de variación - Superficie_Corporalcv_superficie <- sd(DatasetE$Superficie_Corporal, na.rm = TRUE) / mean(DatasetE$Superficie_Corporal, na.rm = TRUE)
print(cv_superficie)## [1] 0.1326952Altura: Es la que tiene coeficiente de variabilidad mas bajo osea que los datos de la muestra no varian tanto entre si, respecto a la media.
Peso: Tiene coeficiente de variabilidad alto osea que los datos de la muestra varian bastante uno respecto al otro, comparado a la media respecto a la media.
Edad: Tiene el coeficiente de variabilidad mas alto de los 3, osea que los datos muestran mayor lejania entre ellos y su media.
PARCIAL 2
Medidas de posicion
Percentiles, rango intercuartil, diagramas de caja y bigotes
#percentiles para edad
quantile(DatasetE$Superficie_Corporal, probs = c(0.25, 0.5, 0.75, 0.9, 1))## 25% 50% 75% 90% 100%
## 1.62700 1.75700 1.94975 2.08670 2.63300# Rango intercuartil
IQR(DatasetE$Superficie_Corporal)## [1] 0.32275# diagrama de caja y bigotes
boxplot(DatasetE$Superficie_Corporal, main = "Caja y Bigotes - Superficie_Corporal", ylab = "m2",col = "lightblue")
#percentiles para edad
quantile(DatasetE$IMC, probs = c(0.25, 0.5, 0.75, 0.9, 1))## 25% 50% 75% 90% 100%
## 21.0225 23.9750 27.7725 30.1450 36.1600# Rango intercuartil
IQR(DatasetE$IMC)## [1] 6.75# diagrama de caja y bigotes
boxplot(DatasetE$IMC, main = "Caja y Bigotes - IMC", ylab = "imc",col = "lightblue")
#percentiles para edad
quantile(DatasetE$Edad, probs = c(0.25, 0.5, 0.75, 0.9, 1))## 25% 50% 75% 90% 100%
## 21.00 22.00 24.25 31.00 55.00# Rango intercuartil
IQR(DatasetE$Edad)## [1] 3.25# diagrama de caja y bigotes
boxplot(DatasetE$Edad, main = "Caja y Bigotes - Edad", ylab = "Años",col = "lightblue")
# percentiles para altura
quantile(DatasetE$Altura, probs = c(0.25, 0.5, 0.75, 0.9, 1))## 25% 50% 75% 90% 100%
## 1.6275 1.6600 1.7500 1.8000 1.9300# Rango intercuartil
IQR(DatasetE$Altura)## [1] 0.1225# diagrama de caja y bigotes
boxplot(DatasetE$Altura, main = "Caja y Bigotes - Altura", ylab = "metros", col = "lightblue")
# Percentiles para Peso
quantile(DatasetE$Peso, probs = c(0.25, 0.5, 0.75, 0.9, 1))## 25% 50% 75% 90% 100%
## 58.00 66.50 80.00 89.94 130.00# Rango intercuartil
IQR(DatasetE$Peso)## [1] 22# diagrama de caja y bigotes
boxplot(DatasetE$Peso, main = "Caja y Bigotes - Peso", ylab = "Kg", col = "lightblue")
Los diagramas de caja y bigotes muestran diferentes niveles de dispersión y la presencia de algunos valores atípicos, especialmente en las variables relacionadas con el peso y el IMC. Esto evidencia que la muestra presenta una alta variabilidad, permitiendo identificar diferencias en la distribución de los datos entre los individuos analizados.
Matriz de diagramas de dispersión
# Seleccionar las variables
variables <- DatasetE[, c("Peso", "Edad", "Altura", "IMC", "Superficie_Corporal")]
# Crear matriz de diagramas de dispersión
pairs(variables,
main = "Matriz de diagramas de dispersión",
pch = 19)
ggpairs(variables)
Gráficos de dispersión
# Dispersión Edad vs Peso
plot(DatasetE$Edad, DatasetE$Peso, main = "Dispersión Edad vs Peso", xlab = "Edad (años)", ylab = "Peso (kg)", col = "darkblue", pch = 19)
# Dispersión Altura vs Peso
plot(DatasetE$Altura, DatasetE$Peso, main = "Dispersión Altura vs Peso", xlab = "Altura (m)", ylab = "Peso (kg)", col = "darkgreen", pch = 19)
# Dispersión Edad vs Altura
plot(DatasetE$Edad, DatasetE$Altura, main = "Dispersión Edad vs Altura", xlab = "Edad (años)", ylab = "Altura (m)", col = "purple", pch = 19)
Los diagramas de dispersión nos muestran una relación positiva entre la
altura y el peso, ya que, en general, las personas con mayor estatura
tienden a presentar un mayor peso. En contraste, las relaciones entre
edad y peso y entre edad y altura son más dispersas, lo que muestra una
asociación menos marcada entre estas variables.
La matriz de diagramas de dispersión a su vez confirma las relaciones vistas en la matriz de correlación. Se evidencia una correlación muy fuerte entre Peso y Superficie Corporal (0.985), seguida de Peso e IMC (0.864), donde los puntos siguen una tendencia ascendente al igual que Altura y Superficie Corporal (0.744) . Edad y Altura (0.039) muestran una relación prácticamente nula.
Covarianza
# Covarianza entre Edad y Peso
cov(DatasetE$Edad, DatasetE$Peso)## [1] 34.19165# Covarianza entre Edad y Altura
cov(DatasetE$Edad, DatasetE$Altura)## [1] 0.02393951# Covarianza entre Edad e IMC
cov(DatasetE$Edad, DatasetE$IMC)## [1] 10.97006# Covarianza entre Edad y Superficie Corporal
cov(DatasetE$Edad, DatasetE$Superficie_Corporal)## [1] 0.4464599# Covarianza entre Peso y Altura
cov(DatasetE$Peso, DatasetE$Altura)## [1] 0.9318514# Covarianza entre Peso e IMC
cov(DatasetE$Peso, DatasetE$IMC)## [1] 60.4676# Covarianza entre Peso y Superficie Corporal
cov(DatasetE$Peso, DatasetE$Superficie_Corporal)## [1] 3.7379# Covarianza entre Altura e IMC
cov(DatasetE$Altura, DatasetE$IMC)## [1] 0.06440429# Covarianza entre Altura y Superficie Corporal
cov(DatasetE$Altura, DatasetE$Superficie_Corporal)## [1] 0.01661755# Covarianza entre IMC y Superficie Corporal
cov(DatasetE$IMC, DatasetE$Superficie_Corporal)## [1] 0.8063693# Matriz de covarianzas
cov(DatasetE[, c("Edad",
"Peso",
"Altura",
"IMC",
"Superficie_Corporal")])## Edad Peso Altura IMC
## Edad 43.22171397 34.1916542 0.02393951 10.97006441
## Peso 34.19165422 254.6631927 0.93185138 60.46759802
## Altura 0.02393951 0.9318514 0.00882121 0.06440429
## IMC 10.97006441 60.4675980 0.06440429 19.22065906
## Superficie_Corporal 0.44645986 3.7379000 0.01661755 0.80636928
## Superficie_Corporal
## Edad 0.44645986
## Peso 3.73790004
## Altura 0.01661755
## IMC 0.80636928
## Superficie_Corporal 0.05657188se puede ver que las mayores covarianzas corresponden al peso y el IMC, indicando que ambas variables presentan una variación más marcada. En diferencia, la altura muestra covarianzas bajas con las demás variables, mientras que la superficie corporal presenta una asociación positiva, aunque de menor magnitud.
y a su vez muestra que el peso es la variable con mayor variabilidad y la que presenta las asociaciones más fuertes con las demás variables. La relación positiva más destacada es entre peso e IMC, indicando que ambas aumentan a la vez. La altura presenta covarianzas bajas con las demás variables. En general, el peso es la variable que más influye en la variabilidad conjunta de los datos.
Correlación lineal de Pearson
variables <- DatasetE[, c(
"Edad",
"Peso",
"Altura",
"IMC",
"Superficie_Corporal"
)]
# Calcular la matriz de correlación de Pearson
cor_pearson <- cor(
variables,
method = "pearson",
use = "complete.obs"
)
# Mostrar la matriz de correlación
cor_pearson## Edad Peso Altura IMC
## Edad 1.00000000 0.3259013 0.03877039 0.3806046
## Peso 0.32590125 1.0000000 0.62172665 0.8642820
## Altura 0.03877039 0.6217267 1.00000000 0.1564108
## IMC 0.38060461 0.8642820 0.15641075 1.0000000
## Superficie_Corporal 0.28551644 0.9847915 0.74387955 0.7733027
## Superficie_Corporal
## Edad 0.2855164
## Peso 0.9847915
## Altura 0.7438796
## IMC 0.7733027
## Superficie_Corporal 1.0000000# Graficar la matriz de correlación
corrplot(
cor_pearson,
method = "color",
type = "upper",
addCoef.col = "black",
tl.col = "black",
tl.srt = 45)
Vemos una correlación muy fuerte entre Peso y Superficie Corporal
(0.98), seguida de Peso e IMC (0.86), indicando una asociación positiva
elevada. También se observa una correlación alta entre IMC y Superficie
Corporal (0.77) y entre Altura y Superficie Corporal (0.74). En
contraste, la Edad presenta correlaciones bajas con las demás variables,
siendo la menor con Altura (0.04).
se denota que la relación más fuerte se presenta entre el peso y la altura, con una correlación positiva de 0.622, lo que indica que, a mayor altura tiende a observarse un mayor peso. A pesar de eso la edad presenta una correlación positiva débil con el peso (0.326) y una correlación prácticamente nula con la altura (0.039), lo que muestra que la edad tiene una influencia limitada sobre estas variables.
Matriz de correlación de Spearman
cor_spearman <- cor(
variables,
method = "spearman"
)
cor_spearman## Edad Peso Altura IMC Superficie_Corporal
## Edad 1.0000000 0.3629901 0.1444730 0.3693184 0.3375361
## Peso 0.3629901 1.0000000 0.6220084 0.8672057 0.9821424
## Altura 0.1444730 0.6220084 1.0000000 0.1828821 0.7456322
## IMC 0.3693184 0.8672057 0.1828821 1.0000000 0.7664467
## Superficie_Corporal 0.3375361 0.9821424 0.7456322 0.7664467 1.0000000corrplot(cor_spearman,
method = "color",
type = "upper",
addCoef.col = "black",
tl.col = "black")
se ve una correlación muy fuerte entre Peso y Superficie Corporal (0.98)
y entre Peso e IMC (0.87). También hay correlación fuerte entre Altura y
Superficie Corporal (0.75), mientras que la Edad presenta asociaciones
débiles con las demás variables, siendo la menor con Altura (0.14).
Matriz de correlación de Kendall
cor_kendall <- cor(
variables,
method = "kendall"
)
cor_kendall## Edad Peso Altura IMC Superficie_Corporal
## Edad 1.0000000 0.2597304 0.1092576 0.2583384 0.2440880
## Peso 0.2597304 1.0000000 0.4629421 0.6951799 0.9069617
## Altura 0.1092576 0.4629421 1.0000000 0.1376317 0.5642572
## IMC 0.2583384 0.6951799 0.1376317 1.0000000 0.5830915
## Superficie_Corporal 0.2440880 0.9069617 0.5642572 0.5830915 1.0000000corrplot(cor_kendall,
method = "color",
type = "upper",
addCoef.col = "black",
tl.col = "black")
muestra una correlación muy fuerte entre Peso y Superficie Corporal
(0.91), seguida de Peso e IMC (0.70). También se observa una correlación
moderada entre IMC y Superficie Corporal (0.58) y entre Altura y
Superficie Corporal (0.56). En contraste, la Edad presenta asociaciones
débiles con las demás variables, siendo la menor con Altura (0.11), lo
que indica una escasa relación entre estas variables.
Gráfico 3D: Peso, Altura e IMC
plot_ly(
data = variables,
x = ~Altura,
y = ~Peso,
z = ~IMC,
type = "scatter3d",
mode = "markers",
marker = list(size = 4)
)El gráfico 3D es creciente entre las tres variables, evidenciando que a medida que aumenta el peso, también tiende a aumentar el IMC, especialmente en individuos con mayor altura. La mayor concentración de personas se encuentra entre 60 y 90 kg de peso, 1.60 y 1.80 m de altura e IMC entre 22 y 30.
Gráfico 3D: Peso, Edad y Superficie Corporal
plot_ly(
data = variables,
x = ~Edad,
y = ~Peso,
z = ~Superficie_Corporal,
type = "scatter3d",
mode = "markers",
marker = list(size = 4)
)El gráfico 3D tiene relación positiva entre el peso y la superficie corporal, donde a mayor peso, mayor superficie corporal. La edad presenta una relación menor, ya que los datos se encuentran dispersos a lo largo de este eje sin una tendencia marcada. La mayor concentración de observaciones corresponde a individuos con 20 a 35 años, 60 a 90 kg de peso y una superficie corporal entre 1.7 y 2.1.
Medidas de similaridad para variables no numéricas
library(cluster)
# Seleccionar variables categóricas
variables_categoricas <- DatasetE[, c(
"Genero",
"Historial_familiar_con_sobrepeso",
"FAVC",
"FUMA",
"SCC",
"MTRANS"
)]
# Convertir variables a factores
variables_categoricas[] <- lapply(
variables_categoricas,
factor
)
# Calcular distancia de Gower
distancia_gower <- daisy(
variables_categoricas,
metric = "gower"
)
# Convertir a matriz
matriz_gower <- as.matrix(distancia_gower)
# Mostrar matriz de distancia de los primeros 5 individuos
matriz_gower[1:5, 1:5]## 1 2 3 4 5
## 1 0.0000000 0.3333333 0.1666667 0.5000000 0.3333333
## 2 0.3333333 0.0000000 0.5000000 0.8333333 0.6666667
## 3 0.1666667 0.5000000 0.0000000 0.3333333 0.1666667
## 4 0.5000000 0.8333333 0.3333333 0.0000000 0.1666667
## 5 0.3333333 0.6666667 0.1666667 0.1666667 0.0000000# Buscar los pares de individuos más similares
# Se eliminan las comparaciones de cada individuo consigo mismo
matriz_gower[lower.tri(matriz_gower, diag = TRUE)] <- NA
# Crear tabla con todos los pares de individuos
pares_similares <- which(
!is.na(matriz_gower),
arr.ind = TRUE
)
# Crear tabla ordenada por menor distancia
resultado_similitud <- data.frame(
Individuo_1 = pares_similares[, 1],
Individuo_2 = pares_similares[, 2],
Distancia_Gower = matriz_gower[pares_similares]
)
# Ordenar de menor a mayor distancia
resultado_similitud <- resultado_similitud[
order(resultado_similitud$Distancia_Gower),
]
# Mostrar los 10 pares más similares
head(resultado_similitud, 10)## Individuo_1 Individuo_2 Distancia_Gower
## 26 5 8 0
## 45 9 10 0
## 54 9 11 0
## 55 10 11 0
## 71 5 13 0
## 74 8 13 0
## 84 6 14 0
## 100 9 15 0
## 101 10 15 0
## 102 11 15 0la matriz de distancias Gower muestra los pares de individuos de mayor similitud en las variables categóricas. Esto muestra que los individuos presentan una distancia de Gower igual a 0. Esto indica que dichos individuos coinciden completamente en las variables consideradas que son género, historial familiar de sobrepeso, FAVC, FUMA, SCC y MTRANS.
Distancias (Gower)
Se seleccionó la distancia de Gower debido a que el conjunto de datos analizados contiene variables de diferentes tipos, incluyendo variables numéricas, continuas, ordinales y nominales ( en este caso tenemos en cuenta la mayoria de los datos por nuestra hipotesis de las causas de obesidad) . Esta medida nos permite combinar adecuadamente estas características al calcular la similitud entre individuos, sin necesidad de transformar las variables categóricas en valores numéricos que puedan generar distorsiones. De esta manera, la distancia de Gower nos permite obtener una comparación más representativa de las características físicas y hábitos de los individuos.
library(cluster)
# Crear una copia de la base de datos
datos <- DatasetE
nominales <- c(
"Genero",
"Historial_familiar_con_sobrepeso",
"FAVC",
"FUMA",
"SCC",
"MTRANS"
)
datos[nominales] <- lapply(datos[nominales], factor)
ordinales <- c(
"FCVC",
"NCP",
"CAEC",
"CH2O",
"FAF",
"TUE",
"CALC",
"NObeyesdad"
)
datos$FCVC <- factor(datos$FCVC,
ordered = TRUE)
datos$NCP <- factor(datos$NCP,
ordered = TRUE)
datos$CAEC <- factor(datos$CAEC,
ordered = TRUE)
datos$CH2O <- factor(datos$CH2O,
ordered = TRUE)
datos$FAF <- factor(datos$FAF,
ordered = TRUE)
datos$TUE <- factor(datos$TUE,
ordered = TRUE)
datos$CALC <- factor(datos$CALC,
ordered = TRUE)
datos$NObeyesdad <- factor(datos$NObeyesdad,
ordered = TRUE)Creamos nuestra matriz utilizando la distancia gower
distancia <- daisy(
datos,
metric = "gower"
)
as.matrix(distancia)[1:5, 1:5]## 1 2 3 4 5
## 1 0.0000000 0.2872475 0.1506237 0.3671619 0.3047976
## 2 0.2872475 0.0000000 0.3668742 0.4263392 0.4692380
## 3 0.1506237 0.3668742 0.0000000 0.2199338 0.2354109
## 4 0.3671619 0.4263392 0.2199338 0.0000000 0.2370837
## 5 0.3047976 0.4692380 0.2354109 0.2370837 0.0000000Ahora agrupamos en grupos donde estas distancias sean las mas parecidas (en nuestro caso 6)…
grupos <- pam(
distancia,
k = 6
)
datos$Grupo <- grupos$clustering
table(datos$Grupo)##
## 1 2 3 4 5 6
## 18 11 13 16 28 18Ahora vemos la media de cada grupo de medidas numericas
tabla_numericas <- datos %>%
group_by(Grupo) %>%
summarise(
Edad = mean(Edad),
Altura = mean(Altura),
Peso = mean(Peso),
IMC = mean(IMC),
Superficie_Corporal = mean(Superficie_Corporal)
)
as.data.frame (tabla_numericas)## Grupo Edad Altura Peso IMC Superficie_Corporal
## 1 1 24.72222 1.738889 78.27778 25.78833 1.936333
## 2 2 23.09091 1.614545 52.72727 20.21636 1.534909
## 3 3 24.00000 1.679231 62.83077 22.06231 1.706308
## 4 4 27.50000 1.623750 63.71875 23.95938 1.687125
## 5 5 23.07143 1.717143 72.33929 24.48214 1.850429
## 6 6 25.88889 1.651667 76.61111 28.03222 1.871556La moda en variables categoricas
moda <- function(x){
names(sort(table(x), decreasing = TRUE))[1]
}
tabla_ordinales <- datos %>%
group_by(Grupo) %>%
summarise(
FCVC = moda(FCVC),
NCP = moda(NCP),
CAEC = moda(CAEC),
CH2O = moda(CH2O),
FAF = moda(FAF),
TUE = moda(TUE),
CALC = moda(CALC),
NObeyesdad = moda(NObeyesdad)
)
as.data.frame (tabla_ordinales)## Grupo FCVC NCP CAEC CH2O FAF TUE CALC
## 1 1 A veces Tres A veces Entre 1 y 2L 2-4 días 3-5 horas A veces
## 2 2 Siempre Tres A veces Más de 2L 2-4 días 0-2 horas No
## 3 3 A veces Tres A veces Entre 1 y 2L Ninguna 0-2 horas A veces
## 4 4 Siempre Tres A veces Entre 1 y 2L Ninguna 0-2 horas A veces
## 5 5 A veces Tres A veces Entre 1 y 2L 1-2 días 3-5 horas A veces
## 6 6 A veces Tres A veces Entre 1 y 2L Ninguna 0-2 horas No
## NObeyesdad
## 1 Peso normal
## 2 Peso normal
## 3 Peso normal
## 4 Peso normal
## 5 Peso normal
## 6 Sobrepeso IILa moda en variables nominales
moda <- function(x) {
x <- na.omit(x)
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
tabla_nominales <- datos %>%
group_by(Grupo) %>%
summarise(
Genero = moda(Genero),
Historial_familiar = moda(Historial_familiar_con_sobrepeso),
FAVC = moda(FAVC),
FUMA = moda(FUMA),
SCC = moda(SCC),
MTRANS = moda(MTRANS)
)
as.data.frame (tabla_nominales)## Grupo Genero Historial_familiar FAVC FUMA SCC MTRANS
## 1 1 Masculino Si No No No Transporte público
## 2 2 Femenino Si No No Si Transporte público
## 3 3 Masculino No No No No Transporte público
## 4 4 Femenino Si Si No No Automóvil
## 5 5 Masculino Si Si No No Transporte público
## 6 6 Femenino Si Si No No Transporte públicoelegimos las variables que mas diferencian los grupos
perfil_chernoff <- datos %>%
group_by(Grupo) %>%
summarise(
IMC = mean(IMC),
Peso = mean(Peso),
NObeyesdad = mean(as.numeric(NObeyesdad)),
Edad = mean(Edad),
FAF = mean(as.numeric(FAF)),
FCVC = mean(as.numeric(FCVC)),
CH2O = mean(as.numeric(CH2O)),
TUE = mean(as.numeric(TUE)),
Historial_familiar = mean(as.numeric(Historial_familiar_con_sobrepeso))
)
as.data.frame(perfil_chernoff)## Grupo IMC Peso NObeyesdad Edad FAF FCVC CH2O
## 1 1 25.78833 78.27778 4.555556 24.72222 2.388889 1.444444 1.611111
## 2 2 20.21636 52.72727 2.909091 23.09091 2.272727 2.636364 1.727273
## 3 3 22.06231 62.83077 4.307692 24.00000 3.230769 1.307692 1.230769
## 4 4 23.95938 63.71875 3.937500 27.50000 2.562500 2.562500 1.250000
## 5 5 24.48214 72.33929 3.964286 23.07143 2.071429 1.357143 1.464286
## 6 6 28.03222 76.61111 4.944444 25.88889 3.666667 1.333333 1.944444
## TUE Historial_familiar
## 1 2.055556 1.777778
## 2 1.363636 1.727273
## 3 1.076923 1.076923
## 4 1.375000 1.812500
## 5 1.892857 1.892857
## 6 1.500000 1.833333 datos_caras <- perfil_chernoff[, -1]
datos_caras <- scale(datos_caras)
datos_caras <- perfil_chernoff[, c(
"IMC",
"Peso",
"Edad",
"NObeyesdad",
"FAF",
"FCVC",
"CH2O",
"TUE",
"Historial_familiar"
)]Caras Chernoff
faces(
datos_caras,
labels = paste("Grupo", perfil_chernoff$Grupo),
main = "Perfiles de los grupos obtenidos con distancia de Gower"
)
## effect of variables:
## modified item Var
## "height of face " "IMC"
## "width of face " "Peso"
## "structure of face" "Edad"
## "height of mouth " "NObeyesdad"
## "width of mouth " "FAF"
## "smiling " "FCVC"
## "height of eyes " "CH2O"
## "width of eyes " "TUE"
## "height of hair " "Historial_familiar"
## "width of hair " "IMC"
## "style of hair " "Peso"
## "height of nose " "Edad"
## "width of nose " "NObeyesdad"
## "width of ear " "FAF"
## "height of ear " "FCVC"interpretacion <- data.frame(
Grupo = c(
"Grupo 1",
"Grupo 2",
"Grupo 3",
"Grupo 4",
"Grupo 5",
"Grupo 6"
),
Interpretacion = c(
"Presenta un IMC y peso elevados, con un nivel de obesidad alto. Se caracteriza por una actividad física intermedia, bajo consumo de vegetales y consumo moderado de agua, lo que sugiere un perfil asociado a hábitos alimenticios poco favorables.",
"Es el grupo con menor peso e IMC. Presenta mayor consumo de vegetales y menor uso de tecnología, indicando un perfil con hábitos de vida más saludables y menor riesgo de obesidad.",
"Posee un IMC bajo y un consumo elevado de vegetales, además de bajo uso de tecnología y menor historial familiar de sobrepeso. Aunque presenta menor consumo de agua, refleja un perfil con hábitos generalmente saludables.",
"Corresponde al grupo con mayor edad promedio y buena actividad física. Presenta un IMC intermedio y consumo moderado de vegetales, aunque con menor consumo de agua y un historial familiar relativamente alto.",
"Presenta peso e IMC relativamente elevados, acompañado de menor actividad física y mayor antecedente familiar de sobrepeso. Este perfil sugiere una mayor predisposición al sobrepeso.",
"Es el grupo con el mayor IMC y el mayor nivel de obesidad. Aunque realiza más actividad física que los demás grupos, presenta bajo consumo de vegetales y un elevado antecedente familiar, indicando que el estado nutricional depende de múltiples factores además de la actividad física."
),
stringsAsFactors = FALSE
)
kable(
interpretacion,
caption = "Interpretación de los perfiles obtenidos mediante la distancia de Gower y las caras de Chernoff"
)| Grupo | Interpretacion |
|---|---|
| Grupo 1 | Presenta un IMC y peso elevados, con un nivel de obesidad alto. Se caracteriza por una actividad física intermedia, bajo consumo de vegetales y consumo moderado de agua, lo que sugiere un perfil asociado a hábitos alimenticios poco favorables. |
| Grupo 2 | Es el grupo con menor peso e IMC. Presenta mayor consumo de vegetales y menor uso de tecnología, indicando un perfil con hábitos de vida más saludables y menor riesgo de obesidad. |
| Grupo 3 | Posee un IMC bajo y un consumo elevado de vegetales, además de bajo uso de tecnología y menor historial familiar de sobrepeso. Aunque presenta menor consumo de agua, refleja un perfil con hábitos generalmente saludables. |
| Grupo 4 | Corresponde al grupo con mayor edad promedio y buena actividad física. Presenta un IMC intermedio y consumo moderado de vegetales, aunque con menor consumo de agua y un historial familiar relativamente alto. |
| Grupo 5 | Presenta peso e IMC relativamente elevados, acompañado de menor actividad física y mayor antecedente familiar de sobrepeso. Este perfil sugiere una mayor predisposición al sobrepeso. |
| Grupo 6 | Es el grupo con el mayor IMC y el mayor nivel de obesidad. Aunque realiza más actividad física que los demás grupos, presenta bajo consumo de vegetales y un elevado antecedente familiar, indicando que el estado nutricional depende de múltiples factores además de la actividad física. |
En general, los grupos evidencian la existencia de diferentes perfiles asociados al estado nutricional. Los grupos con mayores niveles de obesidad (1, 5 y 6) presentan en común valores más altos de IMC y peso, un mayor antecedente familiar de sobrepeso y un menor consumo de vegetales, lo que sugiere que estos factores están relacionados con un mayor riesgo de obesidad dentro de la población . En cambio, los grupos 2 y 3 muestran menores valores de IMC y peso, acompañados de un mayor consumo de vegetales y un menor uso de tecnología, características que reflejan hábitos más saludables. Además, se observa que una mayor actividad física, como ocurre en el grupo 6, no necesariamente se traduce en menores niveles de obesidad, lo que confirma que la obesidad es el resultado de la interacción de múltiples factores, como la alimentación, los antecedentes familiares y las características corporales.
Estimación de la distribución de los datos usando funciones usando densidades kernel.
Usar kernel fijo y variar anchos de banda y comparar la calidad de la estimación. use el kernel gaussiano
hist(DatasetE$Superficie_Corporal, probability = TRUE, col = "lightgray", main = "Comparacion de anchos de banda (Superficie Corporal)", xlab = "Superficie Corporal", ylim = c(0, 2))
lines(density(DatasetE$Superficie_Corporal, bw = 0.05), col = "red", lwd = 2)
lines(density(DatasetE$Superficie_Corporal, bw = 0.1), col = "blue", lwd = 2)
lines(density(DatasetE$Superficie_Corporal, bw = 0.2), col = "green", lwd = 2)
# Valor óptimo
bw_opt_sc <- bw.SJ(DatasetE$Superficie_Corporal)
lines(density(DatasetE$Superficie_Corporal, bw = bw_opt_sc), col = "purple", lwd = 2)
legend("topright", legend = c("h=0.05", "h=0.1", "h=0.2", paste("bw.SJ=", round(bw_opt_sc,3))),
col = c("red", "blue", "green", "purple"), lwd = 2)
hist(DatasetE$IMC, probability = TRUE, col = "lightgray",main = "Comparación de anchos de banda (IMC)", xlab = "IMC")
lines(density(DatasetE$IMC, bw = 1), col = "red", lwd = 2)
lines(density(DatasetE$IMC, bw = 2), col = "blue", lwd = 2)
lines(density(DatasetE$IMC, bw = 3), col = "green", lwd = 2)
bw_opt_imc <- bw.SJ(DatasetE$IMC)
lines(density(DatasetE$IMC, bw = bw_opt_imc), col = "purple", lwd = 2)
legend("topright", legend = c("h=1", "h=2", "h=3", paste("bw.SJ≈", round(bw_opt_imc,3))), col = c("red", "blue", "green", "purple"), lwd = 2)
hist(DatasetE$Peso, probability = TRUE, col = "lightgray", main = "Comparación de anchos de banda (Peso)", xlab = "Peso", ylim = c(0, 0.03))
lines(density(DatasetE$Peso, bw = 4), col = "red", lwd = 2)
lines(density(DatasetE$Peso, bw = 7), col = "blue", lwd = 2)
lines(density(DatasetE$Peso, bw = 10), col = "green", lwd = 2)
bw_opt_peso <- bw.SJ(DatasetE$Peso)
lines(density(DatasetE$Peso, bw = bw_opt_peso), col = "purple", lwd = 2)
legend("topright", legend = c("h=4", "h=7", "h=10", paste("bw.SJ =", round(bw_opt_peso,3))), col = c("red", "blue", "green", "purple"), lwd = 2)
hist(DatasetE$Altura, probability = TRUE, col = "lightgray", main = "Comparación de anchos de banda (Altura)", xlab = "Altura", ylim = c(0, 6))
lines(density(DatasetE$Altura, bw = 0.02), col = "red", lwd = 2)
lines(density(DatasetE$Altura, bw = 0.03), col = "blue", lwd = 2)
lines(density(DatasetE$Altura, bw = 0.04), col = "green", lwd = 2)
bw_opt_altura <- bw.SJ(DatasetE$Altura)
lines(density(DatasetE$Altura, bw = bw_opt_altura), col = "purple", lwd = 2)
legend("topright", legend = c("h=0.02", "h=0.03", "h=0.04", paste("bw.SJ≈", round(bw_opt_altura,3))), col = c("red", "blue", "green", "purple"), lwd = 2)
hist(DatasetE$Edad, probability = TRUE, col = "lightgray", main = "Comparación de anchos de banda (Edad)", xlab = "Edad", ylim = c(0, 0.18))
lines(density(DatasetE$Edad, bw = 2), col = "red", lwd = 2)
lines(density(DatasetE$Edad, bw = 3), col = "blue", lwd = 2)
lines(density(DatasetE$Edad, bw = 4), col = "green", lwd = 2)
bw_opt_edad <- bw.SJ(DatasetE$Edad)
lines(density(DatasetE$Edad, bw = bw_opt_edad), col = "purple", lwd = 2)
legend("topright", legend = c("h=2", "h=3", "h=4", paste("bw.SJ≈", round(bw_opt_edad,3))), col = c("red", "blue", "green", "purple"), lwd = 2)
superficie corporal
La distribución presenta mayor concentración entre 1.6 y 2.0 m², con una ligera asimetría hacia la derecha. Preferimos el ancho de banda de Sheather-Jones (0.087) ofrece una curva equilibrada.
imc
La mayor densidad se encuentra entre 20 y 30 de IMC, con una ligera cola hacia valores altos. Preferimos el ancho de banda de Sheather-Jones (1.392) representa adecuadamente la forma general sin perder información importante.
peso
La distribución del peso se concentra principalmente entre 55 y 85 kg, con una cola hacia los valores más altos. Preferimos el ancho de banda de Sheather-Jones (5.318) da un buen equilibrio entre suavidad y detalle de la distribución.
altura
La altura presenta una distribución aproximadamente unimodal, concentrada entre 1.60 y 1.80 m. Preferimos el ancho de banda de Sheather-Jones (0.022) logra una estimación suave conservando la forma principal de los datos.
edad
La distribución se concentra principalmente entre los 20 y 25 años, con una cola hacia edades mayores. preferimos el ancho de banda de Sheather-Jones (0.697) suaviza adecuadamente la curva sin ocultar el patrón general de la distribución.
Para un mismo ancho de banda usar diferentes funciones kernel y comparar la calidad de la estimación.
hist(DatasetE$Superficie_Corporal, probability = TRUE, col = "lightgray", main = "Comparación de kernels (Superficie Corporal)", xlab = "Superficie Corporal")
lines(density(DatasetE$Superficie_Corporal, bw = bw_opt_sc , kernel = "gaussian"), col = "red", lwd = 2)
lines(density(DatasetE$Superficie_Corporal, bw = bw_opt_sc , kernel = "epanechnikov"), col = "blue", lwd = 2)
lines(density(DatasetE$Superficie_Corporal, bw = bw_opt_sc , kernel = "rectangular"), col = "green", lwd = 2)
lines(density(DatasetE$Superficie_Corporal, bw = bw_opt_sc , kernel = "triangular"), col = "purple", lwd = 2)
legend("topright", legend = c("Gaussian","Epanechnikov","Rectangular","Triangular"), col = c("red","blue","green","purple"), lwd = 2)
hist(DatasetE$IMC, probability = TRUE, col = "lightgray", main = "Comparación de kernels (IMC)", xlab = "IMC")
lines(density(DatasetE$IMC, bw = bw_opt_imc , kernel = "gaussian"), col = "red", lwd = 2)
lines(density(DatasetE$IMC, bw = bw_opt_imc , kernel = "epanechnikov"), col = "blue", lwd = 2)
lines(density(DatasetE$IMC, bw = bw_opt_imc , kernel = "rectangular"), col = "green", lwd = 2)
lines(density(DatasetE$IMC, bw = bw_opt_imc , kernel = "triangular"), col = "purple", lwd = 2)
legend("topright", legend = c("Gaussian","Epanechnikov","Rectangular","Triangular"), col = c("red","blue","green","purple"), lwd = 2)
hist(DatasetE$Peso, probability = TRUE, col = "lightgray", main = "Comparación de kernels (Peso)", xlab = "Peso")
lines(density(DatasetE$Peso, bw = bw_opt_peso , kernel = "gaussian"), col = "red", lwd = 2)
lines(density(DatasetE$Peso, bw = bw_opt_peso , kernel = "epanechnikov"), col = "blue", lwd = 2)
lines(density(DatasetE$Peso, bw = bw_opt_peso , kernel = "rectangular"), col = "green", lwd = 2)
lines(density(DatasetE$Peso, bw = bw_opt_peso , kernel = "triangular"), col = "purple", lwd = 2)
legend("topright", legend = c("Gaussian","Epanechnikov","Rectangular","Triangular"), col = c("red","blue","green","purple"), lwd = 2)
hist(DatasetE$Altura, probability = TRUE, col = "lightgray",main = "Comparación de kernels (Altura)", xlab = "Altura", ylim = c(0, 6))
lines(density(DatasetE$Altura, bw = bw_opt_altura , kernel = "gaussian"), col = "red", lwd = 2)
lines(density(DatasetE$Altura, bw = bw_opt_altura, kernel = "epanechnikov"), col = "blue", lwd = 2)
lines(density(DatasetE$Altura, bw = bw_opt_altura, kernel = "rectangular"), col = "green", lwd = 2)
lines(density(DatasetE$Altura, bw = bw_opt_altura, kernel = "triangular"), col = "purple", lwd = 2)
legend("topright", legend = c("Gaussian","Epanechnikov","Rectangular","Triangular"), col = c("red","blue","green","purple"), lwd = 2)
hist(DatasetE$Edad, probability = TRUE, col = "lightgray", main = "Comparación de kernels (Edad)", xlab = "Edad", ylim = c(0, 0.2))
lines(density(DatasetE$Edad, bw = 1, kernel = "gaussian"), col = "red", lwd = 2)
lines(density(DatasetE$Edad, bw = 1, kernel = "epanechnikov"), col = "blue", lwd = 2)
lines(density(DatasetE$Edad, bw = 1, kernel = "rectangular"), col = "green", lwd = 2)
lines(density(DatasetE$Edad, bw = 1, kernel = "triangular"), col = "purple", lwd = 2)
legend("topright", legend = c("Gaussian","Epanechnikov","Rectangular","Triangular"), col = c("red","blue","green","purple"), lwd = 2)
sup corporal : La mayor concentración se encuentra entre 1.6 y 2.0 m²;
el kernel gaussiano representa mejor la distribución.
imc: Los valores se concentran principalmente entre 20 y 30; el kernel gaussiano ofrece el ajuste más suave.
peso: La mayor parte de los datos está entre 55 y 85 kg; el kernel gaussiano describe mejor la distribución.
altu: La distribución se concentra entre 1.60 y 1.80 m; el kernel gaussiano proporciona la representación más estable.
edad: La mayor concentración está entre 20 y 25 años; el kernel gaussiano ofrece el mejor ajuste de la densidad.
histograma densi
sup corporal: La media, mediana y moda son cercanas, lo que indica una distribución relativamente simétrica con ligera concentración alrededor de 1.8 m².
imc: La mayor concentración se encuentra entre 20 y 30; la media y la mediana son similares, mientras que la moda se ubica en un valor ligeramente mayor.
peso: La distribución se concentra principalmente entre 55 y 85 kg, con una ligera asimetría hacia los valores altos.
altura: La mayor parte de las observaciones se encuentra entre 1.60 y 1.80 m, mostrando una distribución aproximadamente unimodal.
edad: La mayoría de los individuos tiene entre 20 y 25 años, con una cola hacia edades mayores que evidencia asimetría positiva.
funciones creadas
Samantha Vela
g <- function(x){
x^2 - 4*x + 10
}
g(DatasetE$Edad)## [1] 367 367 447 631 406 735 447 406 490 406 582 367 406 1527 447
## [16] 406 631 735 790 447 406 2506 406 406 367 330 367 447 295 447
## [31] 735 847 490 1375 406 367 406 367 447 367 367 447 367 367 367
## [46] 367 367 367 330 367 367 330 447 447 406 447 406 367 231 330
## [61] 367 330 406 367 367 447 447 790 447 447 406 490 295 490 447
## [76] 490 490 447 447 295 790 447 295 790 1302 1030 406 847 1095 367
## [91] 1450 631 330 2815 367 535 1095 790 735 330 406 1855 406 262Yaira Zarate
distancia_media_plot <- function(x){
media <- mean(x)
distancia <- x - media
barplot(distancia,main = "Distancia de cada valor respecto a la Media", ylab = "Distancia", col = ifelse(distancia >= 0, "green", "orange"))
}
distancia_media_plot(DatasetE$Edad)
Juan Ajiaco
f <- function(x) {
exp(x) + log(x + 2) - 3*x
}Conclusion
A travez de medidas de tendencia central, gráficos de pastel, gráficos de barras, tablas cruzadas, histogramas y análisis respectivo, los datos muestran principalmente jóvenes adultos, con edades entre 20 y 22 años, con altura no muy relevante en los niveles de obesidad, el peso presenta mayor asimetría, por la presencia de casos de sobrepeso y obesidad mostrada en los datos, los hábitos alimenticios y el estilo de vida muestran patrones que pueden relacionarse con el sobre peso, como, el consumo de alimentos calóricos en alta frecuencia y la poca actividad física, ademas de la combinación de antecedentes familiares con sobre peso, alimentación y estilo de vida son uno de los factores combinados que influyen directamente en el nivel de obesidad.
Con esto se permite concluir que la obesidad no depende de un solo factor, si no de la combinacion de variables como edad, peso y hábitos alimenticios como cotidianos. El análisis muestra como los hábitos pueden convertirse en factores para el desarrollo de obesidad, también se evidencia que la prevención debe enfocarse en mejorar los hábitos alimenticios y promover la actividad física regular. # Bibliografia
@misc{obesity_ucidata, author = {{UCI Machine Learning Repository}}, title = {Estimation of Obesity Levels Based on Eating Habits and Physical Condition}, year = {2019}, url = {https://doi.org/10.24432/C5H31Z}, note = {DatasetE} }