Nombre: Gabriel Torres   |   Curso: EyP

Datos

(i) Datos

# El archivo Excel debe estar en la carpeta principal del proyecto
DATOS2026 <- read_excel("00. DATOS202460ULTIMOS25 (1).xlsx")
DATOS2026
# Número total de estudiantes
N <- nrow(DATOS2026)

Total de estudiantes en la muestra: 74

Tablas bivariadas: dos variables cualitativas

(35i) Tabla SEXO vs CURSO

Contamos cuántos estudiantes hay en cada combinación de sexo y curso.

table_bv1 <- table(DATOS2026$SEXO, DATOS2026$CURSO)
knitr::kable(table_bv1)
ESTADISTICAI PROBABILIDAD
Femenino 16 26
Masculino 10 22

(36i) Diagrama de barras SEXO vs CURSO

barp_bv1 <- barplot(table_bv1,
                    main = "Gráfico de barras CURSO vs SEXO", col.main = azul,
                    xlab = "CURSO", ylab = "Frecuencia",
                    col = col_sexo, border = NA, las = 1,
                    legend.text = rownames(table_bv1),
                    args.legend = list(x = "topright", bty = "n"),
                    ylim = c(0, max(table_bv1) * 1.2),
                    beside = TRUE) # Barras agrupadas
text(as.vector(barp_bv1), as.vector(table_bv1), labels = as.vector(table_bv1),
     pos = 3, font = 2, col = azul)

(37i) Tabla ESTRATO vs CURSO

table_bv2 <- table(DATOS2026$ESTRATO, DATOS2026$CURSO)
knitr::kable(table_bv2)
ESTADISTICAI PROBABILIDAD
I 5 10
II 7 18
III 9 9
IV 5 5
V 0 5

(38i) Diagrama de barras ESTRATO vs CURSO

barp_bv2 <- barplot(table_bv2,
                    main = "Gráfico de barras CURSO vs ESTRATO", col.main = azul,
                    xlab = "CURSO", ylab = "Frecuencia",
                    col = pal_n(nrow(table_bv2)), border = NA, las = 1,
                    legend.text = rownames(table_bv2),
                    args.legend = list(x = "topright", title = "ESTRATO", bty = "n"),
                    ylim = c(0, max(table_bv2) * 1.2),
                    beside = TRUE) # Barras agrupadas
text(as.vector(barp_bv2), as.vector(table_bv2), labels = as.vector(table_bv2),
     pos = 3, font = 2, col = azul)

Una cualitativa y una cuantitativa: diagrama de caja

Cuando una variable es cualitativa y la otra cuantitativa, el gráfico adecuado es el boxplot.

(39i) EDAD vs SEXO

x <- DATOS2026$EDAD
y <- DATOS2026$SEXO
boxplot(x ~ y, horizontal = TRUE, col = col_sexo, border = azul, las = 1,
        main = "EDAD vs SEXO", col.main = azul, xlab = "EDAD", ylab = "SEXO")

(40i) EDAD vs ESTRATO

x <- DATOS2026$EDAD
z <- DATOS2026$ESTRATO
boxplot(x ~ z, horizontal = TRUE, col = pal_n(length(unique(z))), border = azul, las = 1,
        main = "EDAD vs ESTRATO", col.main = azul, xlab = "EDAD", ylab = "ESTRATO")

(41i) ESTATURA vs SEXO

x <- DATOS2026$ESTATURA
z <- DATOS2026$SEXO
boxplot(x ~ z, horizontal = TRUE, col = col_sexo, border = azul, las = 1,
        main = "ESTATURA vs SEXO", col.main = azul, xlab = "ESTATURA", ylab = "SEXO")

Dos variables cuantitativas: ESTATURA y PESO

(42i) Diagrama de dispersión

Con dos variables cuantitativas usamos un diagrama de dispersión. Las líneas punteadas marcan el valor medio de cada variable.

x <- DATOS2026$ESTATURA
y <- DATOS2026$PESO
plot(x, y, xlab = "ESTATURA", ylab = "PESO", pch = 19, col = verde, las = 1,
     main = "Diagrama de dispersión: PESO vs ESTATURA", col.main = azul)
abline(v = mean(x, na.rm = TRUE), lwd = 3, lty = 2, col = azul)  # media de ESTATURA
abline(h = mean(y, na.rm = TRUE), lwd = 3, lty = 2, col = azul)  # media de PESO

(43i) Medias de ESTATURA y PESO

media_estatura <- mean(DATOS2026$ESTATURA, na.rm = TRUE)
media_peso     <- mean(DATOS2026$PESO, na.rm = TRUE)
knitr::kable(data.frame(Variable = c("ESTATURA", "PESO"),
                        Media = round(c(media_estatura, media_peso), 2)))
Variable Media
ESTATURA 168.39
PESO 63.32

(44i) Recta de regresión lineal simple: PESO en función de ESTATURA

regresion1 <- lm(PESO ~ ESTATURA, data = DATOS2026)
regresion1
## 
## Call:
## lm(formula = PESO ~ ESTATURA, data = DATOS2026)
## 
## Coefficients:
## (Intercept)     ESTATURA  
##    -84.1267       0.8756

(45i) Recta de regresión lineal simple: ESTATURA en función de PESO

regresion2 <- lm(ESTATURA ~ PESO, data = DATOS2026)
regresion2
## 
## Call:
## lm(formula = ESTATURA ~ PESO, data = DATOS2026)
## 
## Coefficients:
## (Intercept)         PESO  
##    137.0763       0.4945

(46i) Resumen del modelo con la función summary

summary(regresion1)
## 
## Call:
## lm(formula = PESO ~ ESTATURA, data = DATOS2026)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -21.7376  -4.4151  -0.4241   4.8025  29.3868 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -84.1267    19.9092  -4.226 6.89e-05 ***
## ESTATURA      0.8756     0.1181   7.416 1.88e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 8.609 on 72 degrees of freedom
## Multiple R-squared:  0.433,  Adjusted R-squared:  0.4252 
## F-statistic: 54.99 on 1 and 72 DF,  p-value: 1.881e-10
summary(regresion2)
## 
## Call:
## lm(formula = ESTATURA ~ PESO, data = DATOS2026)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -13.7479  -4.6462  -0.2041   4.1066  16.1973 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 137.07631    4.28941  31.957  < 2e-16 ***
## PESO          0.49453    0.06669   7.416 1.88e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.47 on 72 degrees of freedom
## Multiple R-squared:  0.433,  Adjusted R-squared:  0.4252 
## F-statistic: 54.99 on 1 and 72 DF,  p-value: 1.881e-10

(47i) Diagrama de dispersión y recta de regresión

Los coeficientes de la recta y el coeficiente de correlación se calculan directamente desde el modelo, así que se actualizan solos si cambian los datos.

a <- coef(regresion1)[1]   # Intercepto
b <- coef(regresion1)[2]   # Pendiente
r <- cor(DATOS2026$ESTATURA, DATOS2026$PESO, use = "complete.obs")

plot(DATOS2026$ESTATURA, DATOS2026$PESO, xlab = "ESTATURA", ylab = "PESO",
     pch = 19, col = verde, las = 1, col.main = azul, cex.main = 0.95,
     main = sprintf("y_ajus = a + bx = %.4f + %.4fx,  r = %.4f", a, b, r))
abline(v = media_estatura, lwd = 3, lty = 2, col = "grey60")
abline(h = media_peso,     lwd = 3, lty = 2, col = "grey60")
abline(regresion1, col = coral, lwd = 3)   # recta de regresión ajustada

Conclusión: el coeficiente de correlación entre ESTATURA y PESO es r = 0.658, una relación lineal moderada positiva. La recta ajustada es PESO = -84.1267 + 0.8756 · ESTATURA, y el modelo explica el 43.3 % de la variabilidad del peso.

Problema de aplicación: peso y estatura

En la siguiente base de datos se encuentran consignados los pesos y las estaturas de estudiantes seleccionados al azar de un grupo de Estadística I de la UTB.

(48i) (a) Datos

taller_rl <- data.frame(
  x = c(88, 77, 68, 80, 68, 55, 89, 61, 72, 72, 79, 75, 68, 65, 70, 52, 78, 55, 96, 75, 44, 57, 60, 50, 93),
  y = c(175, 183, 158, 165, 175, 160, 160, 156, 174, 171, 160, 184, 163, 176, 167, 172, 168, 167, 181, 175, 153, 154, 169, 168, 187)
)
# x = PESO (kg)   |   y = ESTATURA (cm)
nrow(taller_rl)   # número de estudiantes en la muestra
## [1] 25

(49i) (b) Diagrama de dispersión

plot(taller_rl$x, taller_rl$y, xlab = "PESO", ylab = "ESTATURA",
     pch = 19, col = verde, las = 1,
     main = "Diagrama de dispersión: ESTATURA vs PESO", col.main = azul)
mean(taller_rl$x)
## [1] 69.88
mean(taller_rl$y)
## [1] 168.84
abline(v = mean(taller_rl$x), lwd = 3, lty = 2, col = azul)  # media de PESO
abline(h = mean(taller_rl$y), lwd = 3, lty = 2, col = azul)  # media de ESTATURA

(50i) (c) Coeficiente de correlación de Pearson

r_taller <- cor(taller_rl$x, taller_rl$y)
r_taller
## [1] 0.5133798

Conclusión: con r = 0.5134 se observa una relación lineal moderada positiva entre la estatura y el peso.

(51i) (d) Recta de regresión lineal simple

regresion3 <- lm(y ~ x, data = taller_rl)
regresion3
## 
## Call:
## lm(formula = y ~ x, data = taller_rl)
## 
## Coefficients:
## (Intercept)            x  
##    143.9296       0.3565

(52i) (e) Resumen del modelo con la función summary

summary(regresion3)
## 
## Call:
## lm(formula = y ~ x, data = taller_rl)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -15.656  -6.614   1.404   6.247  13.335 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 143.9296     8.8404  16.281 4.06e-14 ***
## x             0.3565     0.1242   2.869  0.00867 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 8.315 on 23 degrees of freedom
## Multiple R-squared:  0.2636, Adjusted R-squared:  0.2315 
## F-statistic: 8.231 on 1 and 23 DF,  p-value: 0.008673

(53i) Diagrama de dispersión con la recta ajustada

a3 <- coef(regresion3)[1]   # Intercepto
b3 <- coef(regresion3)[2]   # Pendiente

plot(taller_rl$x, taller_rl$y, xlab = "PESO", ylab = "ESTATURA",
     pch = 19, col = verde, las = 1, col.main = azul, cex.main = 0.95,
     main = sprintf("y_ajus = %.4f + %.4fx,  r = %.4f", a3, b3, r_taller))
abline(v = mean(taller_rl$x), lwd = 3, lty = 2, col = "grey60")
abline(h = mean(taller_rl$y), lwd = 3, lty = 2, col = "grey60")
abline(regresion3, col = coral, lwd = 3)   # recta de regresión ajustada

Datos de grasas en sangre: edad, peso y grasas

(54i) Lectura de los datos y nombres de las variables

Los datos del fichero EdadPesoGrasas.txt corresponden a tres variables medidas en 25 individuos: edad, peso y cantidad de grasas en sangre.

url_grasas <- "http://verso.mat.uam.es/~joser.berrendero/datos/EdadPesoGrasas.txt"

# Intenta leer desde internet; si falla, busca el archivo en la carpeta del proyecto
grasas <- tryCatch(suppressWarnings(read.table(url_grasas, header = TRUE)),
                   error = function(e) NULL)
if (is.null(grasas) && file.exists("EdadPesoGrasas.txt")) {
  grasas <- read.table("EdadPesoGrasas.txt", header = TRUE)
}
if (is.null(grasas)) {
  stop("No se pudo leer EdadPesoGrasas.txt. Descárgalo y súbelo a la carpeta del proyecto.")
}

names(grasas)
## [1] "peso"   "edad"   "grasas"

(55i) Matriz de diagramas de dispersión

pairs(grasas, pch = 19, col = verde, gap = 0.5)

(56i) Matriz de correlación

round(cor(grasas), 4)
##          peso   edad grasas
## peso   1.0000 0.2400 0.2653
## edad   0.2400 1.0000 0.8374
## grasas 0.2653 0.8374 1.0000

(57i) Cálculo de la recta de mínimos cuadrados

regresion_grasas <- lm(grasas ~ edad, data = grasas)
summary(regresion_grasas)
## 
## Call:
## lm(formula = grasas ~ edad, data = grasas)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -63.478 -26.816  -3.854  28.315  90.881 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 102.5751    29.6376   3.461  0.00212 ** 
## edad          5.3207     0.7243   7.346 1.79e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 43.46 on 23 degrees of freedom
## Multiple R-squared:  0.7012, Adjusted R-squared:  0.6882 
## F-statistic: 53.96 on 1 and 23 DF,  p-value: 1.794e-07

(58i) Representación gráfica de la recta de mínimos cuadrados

plot(grasas$edad, grasas$grasas, xlab = "Edad", ylab = "Grasas",
     pch = 19, col = verde, las = 1,
     main = "Recta de mínimos cuadrados: Grasas vs Edad", col.main = azul)
abline(regresion_grasas, col = coral, lwd = 3)

(59i) Predicción con la recta de mínimos cuadrados

Usamos la recta para predecir la cantidad de grasas de individuos con edades de 30, 31, 32, …, 50 años.

nuevas.edades <- data.frame(edad = seq(30, 50))
prediccion <- predict(regresion_grasas, nuevas.edades)
knitr::kable(data.frame(Edad = nuevas.edades$edad,
                        `Grasas predichas` = round(prediccion, 2),
                        check.names = FALSE))
Edad Grasas predichas
30 262.20
31 267.52
32 272.84
33 278.16
34 283.48
35 288.80
36 294.12
37 299.44
38 304.76
39 310.08
40 315.40
41 320.72
42 326.04
43 331.36
44 336.68
45 342.01
46 347.33
47 352.65
48 357.97
49 363.29
50 368.61

FIN DEL LABORATORIO 8