1 LABORATORIO 7: ANÁLISIS DESCRIPTIVO

🎯 Objetivo: Realizar un análisis exploratorio completo usando tablas de frecuencias, gráficos así como estadísticos descriptivos.

1.1 (1i) Datos

# Crear datos de estudiantes
DATOS <- data.frame(
  ID = 1:60,
  SEXO = c(rep("Masculino", 30), rep("Femenino", 30)),
  CURSO = rep(c("Primero", "Segundo", "Tercero", "Cuarto", "Quinto"), 12),
  ESTRATO = rep(c(1, 2, 3, 4, 5, 6), 10),
  EDAD = sample(18:45, 60, replace = TRUE),
  ESTATURA = round(rnorm(60, mean = 1.70, sd = 0.10), 2),
  PESO = round(rnorm(60, mean = 70, sd = 12), 1)
)

head(DATOS, 10)
##    ID      SEXO   CURSO ESTRATO EDAD ESTATURA PESO
## 1   1 Masculino Primero       1   27     1.78 73.2
## 2   2 Masculino Segundo       2   19     1.75 92.3
## 3   3 Masculino Tercero       3   39     1.66 79.7
## 4   4 Masculino  Cuarto       4   38     1.68 51.5
## 5   5 Masculino  Quinto       5   39     1.77 57.4
## 6   6 Masculino Primero       6   31     1.60 61.8
## 7   7 Masculino Segundo       1   37     1.73 80.0
## 8   8 Masculino Tercero       2   25     1.69 84.2
## 9   9 Masculino  Cuarto       3   40     1.51 84.6
## 10 10 Masculino  Quinto       4   38     1.71 65.2

Base de datos con 60 estudiantes así como variables demográficas más antropométricas.

1.2 (2i) Tabla de Frecuencias - SEXO

table_sexo <- table(DATOS$SEXO)
table_sexo
## 
##  Femenino Masculino 
##        30        30

1.3 (3i) Gráfico de Pastel - SEXO

colores_sexo <- c("Femenino" = "#5ECCC3", "Masculino" = "#7A94B8")
pie(table_sexo, col = colores_sexo,
    main = "Distribución por Sexos\nTurquesa (Femenino) · Azul Slate (Masculino)", 
    labels = paste0(names(table_sexo), "\n", table_sexo),
    cex = 1.1, font = 2, border = "white", lwd = 2)

El gráfico de pastel divide el total según categorías. Turquesa para femenino (suave, equilibrio) así como azul slate para masculino (stability, fortaleza).

1.4 (4i) Gráfico de Barras - Frecuencias Absolutas SEXO

barp <- barplot(table_sexo, 
                col = colores_sexo, 
                border = "#2C3E50",
                lwd = 2.5,
                main = "Gráfico de Barras: Distribución por Sexo", 
                xlab = "SEXO", 
                ylab = "Frecuencia",
                ylim = c(0, 35))
text(barp, table_sexo + 0.5, labels = table_sexo, pos = 3, cex = 1.3, font = 2, col = "#2C3E50")

1.5 (5i) Gráfico de Barras - Frecuencias Porcentuales

porcentajes <- round(prop.table(table_sexo) * 100, 1)
bp <- barplot(porcentajes, 
        col = colores_sexo, 
        border = "#2C3E50",
        lwd = 2.5,
        main = "Gráfico de Barras: Porcentajes", 
        xlab = "SEXO", 
        ylab = "Porcentaje (%)",
        ylim = c(0, 60))
text(bp, porcentajes + 1, labels = paste0(porcentajes, "%"), pos = 3, cex = 1.3, font = 2, col = "#2C3E50")

1.6 (6i) Tabla de Contingencia - SEXO × CURSO

table_3 <- table(DATOS$SEXO, DATOS$CURSO)
table_3
##            
##             Cuarto Primero Quinto Segundo Tercero
##   Femenino       6       6      6       6       6
##   Masculino      6       6      6       6       6

1.7 (7i) Gráfico - SEXO vs CURSO

barplot(table_3,
        main = "SEXO vs CURSO",
        xlab = "CURSO", ylab = "Frecuencia",
        col = colores_sexo,
        border = "#2C3E50",
        lwd = 2,
        legend.text = rownames(table_3),
        beside = TRUE,
        args.legend = list(x = "topright", bty = "n", title = "SEXO"))

1.8 (8i) Tabla de Contingencia - SEXO × ESTRATO

table_4 <- table(DATOS$SEXO, DATOS$ESTRATO)
table_4
##            
##             1 2 3 4 5 6
##   Femenino  5 5 5 5 5 5
##   Masculino 5 5 5 5 5 5

1.9 (9i) Gráfico - SEXO vs ESTRATO

barplot(table_4,
        main = "SEXO vs ESTRATO",
        xlab = "ESTRATO", ylab = "Frecuencia",
        col = colores_sexo,
        border = "#2C3E50",
        lwd = 2,
        legend.text = rownames(table_4),
        beside = TRUE,
        args.legend = list(x = "topright", bty = "n", title = "SEXO"))

1.10 (10i) Tabla de Contingencia - ESTRATO × CURSO

table_5 <- table(DATOS$ESTRATO, DATOS$CURSO)
table_5
##    
##     Cuarto Primero Quinto Segundo Tercero
##   1      2       2      2       2       2
##   2      2       2      2       2       2
##   3      2       2      2       2       2
##   4      2       2      2       2       2
##   5      2       2      2       2       2
##   6      2       2      2       2       2

1.11 (11i) Gráfico - ESTRATO vs CURSO

colores_estrato <- c("#7A94B8", "#6BA3B5", "#5ECCC3", "#D9C5A0", "#E8D4B8", "#FDB913")
barplot(table_5,
        main = "ESTRATO vs CURSO",
        xlab = "CURSO", ylab = "Frecuencia",
        col = colores_estrato,
        border = "#2C3E50",
        lwd = 1.8,
        legend.text = paste("Estrato", rownames(table_5)),
        beside = TRUE,
        args.legend = list(x = "topright", bty = "n"))

Gradiente de colores que transita desde azul slate (inicio) a turquesa (medio) así como termina en amarillo dorado, representando la progresión de estratos.

1.12 (12i) Tabla de Contingencia - ESTRATO × SEXO

table_6 <- table(DATOS$ESTRATO, DATOS$SEXO)
table_6
##    
##     Femenino Masculino
##   1        5         5
##   2        5         5
##   3        5         5
##   4        5         5
##   5        5         5
##   6        5         5

1.13 (13i) Gráfico - ESTRATO vs SEXO

barplot(table_6,
        main = "ESTRATO vs SEXO",
        xlab = "SEXO", ylab = "Frecuencia",
        col = colores_estrato,
        border = "#2C3E50",
        lwd = 1.8,
        legend.text = paste("Estrato", rownames(table_6)),
        beside = TRUE,
        args.legend = list(x = "topright", bty = "n"))

1.14 (14i) Resumen Estadístico EDAD

cat("Media:", mean(DATOS$EDAD), "\n")
## Media: 31.53333
cat("Mediana:", median(DATOS$EDAD), "\n")
## Mediana: 32
cat("Desv. Est.:", sd(DATOS$EDAD), "\n")
## Desv. Est.: 8.135435
cat("Min:", min(DATOS$EDAD), "\n")
## Min: 18
cat("Max:", max(DATOS$EDAD), "\n")
## Max: 45

1.15 (15i) Diagrama de Caja - EDAD

boxplot(DATOS$EDAD, horizontal = TRUE, col = "#D9C5A0", border = "#7A94B8", lwd = 2.5,
        main = "Diagrama de Caja - EDAD (Beige: Madurez)")

1.16 (16i) Resumen Estadístico ESTATURA

summary(DATOS$ESTATURA)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.470   1.617   1.700   1.694   1.770   1.950

1.17 (17i) Diagrama de Caja - ESTATURA

boxplot(DATOS$ESTATURA, horizontal = TRUE, col = "#5ECCC3", border = "#7A94B8", lwd = 2.5,
        main = "Diagrama de Caja - ESTATURA (Turquesa: Medida física)")

1.18 (18i) Boxplot - EDAD vs SEXO

boxplot(DATOS$EDAD ~ DATOS$SEXO, horizontal = TRUE, col = colores_sexo,
        main = "EDAD vs SEXO", xlab = "EDAD", border = "#7A94B8", lwd = 2)

1.19 (19i) Boxplot - EDAD vs ESTRATO

boxplot(DATOS$EDAD ~ DATOS$ESTRATO, horizontal = TRUE, col = colores_estrato,
        main = "EDAD vs ESTRATO", xlab = "EDAD", border = "#7A94B8", lwd = 2)

1.20 (20i) Boxplot - ESTATURA vs SEXO

boxplot(DATOS$ESTATURA ~ DATOS$SEXO, horizontal = TRUE, col = colores_sexo,
        main = "ESTATURA vs SEXO", xlab = "ESTATURA", border = "#7A94B8", lwd = 2)

Turquesa así como azul slate representan características diferentes pero complementarias. La estatura varía según sexo, como se refleja en tamaños de caja.

1.21 (21i) Boxplot - ESTATURA vs ESTRATO

boxplot(DATOS$ESTATURA ~ DATOS$ESTRATO, horizontal = TRUE, col = colores_estrato,
        main = "ESTATURA vs ESTRATO", xlab = "ESTATURA", border = "#7A94B8", lwd = 2)

✨ LABORATORIO 7 COMPLETADO
Análisis descriptivo ejecutado exitosamente. Se generaron tablas de frecuencias, gráficos así como diagramas de caja para todas las variables.

LABORATORIO 8

Regresión Lineal y Análisis Bivariado
Clase 32 · Semana 8

2 LABORATORIO 8: REGRESIÓN LINEAL

🎯 Objetivo: Explorar relaciones lineales entre variables cuantitativas utilizando correlación así como regresión.

2.1 (22i) Resumen PESO

summary(DATOS$PESO)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   39.60   63.45   74.75   73.60   84.38  101.00

2.2 (23i) Diagrama de Dispersión - ESTATURA vs PESO

x <- DATOS$ESTATURA
y <- DATOS$PESO

plot(x, y, xlab = "ESTATURA (m)", ylab = "PESO (kg)",
     main = "Diagrama de Dispersión: ESTATURA vs PESO", 
     col = "#FDB913", pch = 19, cex = 1.8,
     xlim = c(1.45, 1.95), ylim = c(40, 105))

abline(v = mean(x), lwd = 2.5, lty = 2, col = "#5ECCC3", alpha = 0.7)
abline(h = mean(y), lwd = 2.5, lty = 2, col = "#5ECCC3", alpha = 0.7)

cat("Media ESTATURA:", round(mean(x), 2), "\n")
## Media ESTATURA: 1.69
cat("Media PESO:", round(mean(y), 2), "\n")
## Media PESO: 73.6

Amarillo dorado para peso/medidas corporales denota energía así como aspecto físico. Turquesa en líneas de media crea balance visual entre calidez así como frialdad.

2.3 (24i) Coeficiente de Correlación

correlacion <- cor(x, y)
cat("Correlación de Pearson:", round(correlacion, 4), "\n")
## Correlación de Pearson: -0.1997

Coeficiente r = -0.1997 indica si estatura así como peso tienen relación fuerte o débil. Valores próximos a ±1 sugieren dependencia lineal significativa.

2.4 (25i) Modelo de Regresión Lineal

modelo <- lm(y ~ x)
modelo
## 
## Call:
## lm(formula = y ~ x)
## 
## Coefficients:
## (Intercept)            x  
##      118.54       -26.54

2.5 (26i) Resumen del Modelo

summary(modelo)
## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -37.016  -7.748   1.289   9.548  25.180 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   118.54      29.01   4.086 0.000137 ***
## x             -26.54      17.10  -1.552 0.126099    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13.95 on 58 degrees of freedom
## Multiple R-squared:  0.03987,    Adjusted R-squared:  0.02332 
## F-statistic: 2.409 on 1 and 58 DF,  p-value: 0.1261

R² cuantifica qué proporción de varianza en peso se explica por estatura. Entre 0 así como 1, donde 1 = ajuste perfecto.

2.6 (27i) Gráfico con Recta de Regresión

plot(x, y, xlab = "ESTATURA (m)", ylab = "PESO (kg)",
     main = "Regresión Lineal: PESO ~ ESTATURA", 
     col = "#FDB913", pch = 19, cex = 1.8,
     xlim = c(1.45, 1.95), ylim = c(40, 105))

abline(v = mean(x), lwd = 2.5, lty = 2, col = "#5ECCC3", alpha = 0.6)
abline(h = mean(y), lwd = 2.5, lty = 2, col = "#5ECCC3", alpha = 0.6)

a <- coef(modelo)[1]
b <- coef(modelo)[2]
abline(a = a, b = b, col = "#7A94B8", lwd = 4)

cat("Ecuación: PESO =", round(a, 2), "+", round(b, 2), "× ESTATURA\n")
## Ecuación: PESO = 118.54 + -26.54 × ESTATURA
legend("topleft", legend = paste0("PESO = ", round(a, 2), " + ", round(b, 2), " × EST"),
       col = "#7A94B8", lwd = 4, bty = "n", cex = 1.1)

Azul slate para tendencia simboliza estabilidad así como confiabilidad. Representa la dirección general, permitiendo predicciones de peso dado estatura.

2.7 (28i) Modelo Inverso

modelo2 <- lm(x ~ y)
modelo2
## 
## Call:
## lm(formula = x ~ y)
## 
## Coefficients:
## (Intercept)            y  
##    1.804264    -0.001503

2.8 (29i) Resumen Modelo Inverso

summary(modelo2)
## 
## Call:
## lm(formula = x ~ y)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.22216 -0.06456  0.01354  0.06696  0.23905 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.8042642  0.0725381  24.873   <2e-16 ***
## y           -0.0015027  0.0009682  -1.552    0.126    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.105 on 58 degrees of freedom
## Multiple R-squared:  0.03987,    Adjusted R-squared:  0.02332 
## F-statistic: 2.409 on 1 and 58 DF,  p-value: 0.1261

2.9 (30i) MATRIZ DE PARES

datos_cuant <- data.frame(
  EDAD = DATOS$EDAD,
  ESTATURA = DATOS$ESTATURA,
  PESO = DATOS$PESO
)

pairs(datos_cuant, main = "Matriz de Diagramas de Dispersión", 
      col = "#7A94B8", pch = 19, cex = 0.8)

2.10 (31i) MATRIZ DE CORRELACIÓN

matriz_cor <- cor(datos_cuant)
print(round(matriz_cor, 4))
##             EDAD ESTATURA    PESO
## EDAD      1.0000  -0.1257 -0.0220
## ESTATURA -0.1257   1.0000 -0.1997
## PESO     -0.0220  -0.1997  1.0000

Matriz simétrica resumiendo todas las correlaciones pairwise. Diagonal siempre 1 (autocorrelación perfecta). Valores ±1 = relaciones lineales fuertes.

3 PROBLEMA DE APLICACIÓN

Enunciado: Análisis de relación entre peso así como estatura en una muestra de estudiantes.

3.1 (32i) Datos

taller <- data.frame(
  peso = 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),
  estatura = 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)
)

head(taller)
##   peso estatura
## 1   88      175
## 2   77      183
## 3   68      158
## 4   80      165
## 5   68      175
## 6   55      160

3.2 (33i) Diagrama de Dispersión

plot(taller$peso, taller$estatura, xlab = "PESO (kg)", ylab = "ESTATURA (cm)",
     main = "Diagrama de Dispersión - Datos de Taller", 
     col = "#FDB913", pch = 19, cex = 2,
     xlim = c(40, 100), ylim = c(150, 190))

abline(v = mean(taller$peso), lwd = 2.5, lty = 2, col = "#5ECCC3")
abline(h = mean(taller$estatura), lwd = 2.5, lty = 2, col = "#5ECCC3")

cat("Media PESO:", round(mean(taller$peso), 2), "\n")
## Media PESO: 69.88
cat("Media ESTATURA:", round(mean(taller$estatura), 2), "\n")
## Media ESTATURA: 168.84

3.3 (34i) Correlación

cor_taller <- cor(taller$peso, taller$estatura)
cat("Correlación:", round(cor_taller, 4), "\n")
## Correlación: 0.5134
cat("Existe relación lineal entre Peso así como Estatura\n")
## Existe relación lineal entre Peso así como Estatura

3.4 (35i) Regresión

reg_taller <- lm(taller$estatura ~ taller$peso)
reg_taller
## 
## Call:
## lm(formula = taller$estatura ~ taller$peso)
## 
## Coefficients:
## (Intercept)  taller$peso  
##    143.9296       0.3565

3.5 (36i) Resumen

summary(reg_taller)
## 
## Call:
## lm(formula = taller$estatura ~ taller$peso)
## 
## 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 ***
## taller$peso   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

3.6 (37i) Gráfico de Regresión

plot(taller$peso, taller$estatura, xlab = "PESO (kg)", ylab = "ESTATURA (cm)",
     main = "Recta de Regresión - Relación Peso-Estatura", 
     col = "#FDB913", pch = 19, cex = 2,
     xlim = c(40, 100), ylim = c(150, 190))

abline(v = mean(taller$peso), lwd = 2.5, lty = 2, col = "#5ECCC3")
abline(h = mean(taller$estatura), lwd = 2.5, lty = 2, col = "#5ECCC3")

a_t <- coef(reg_taller)[1]
b_t <- coef(reg_taller)[2]
abline(a = a_t, b = b_t, col = "#7A94B8", lwd = 4)

cat("Ecuación: ESTATURA =", round(a_t, 2), "+", round(b_t, 2), "× PESO\n")
## Ecuación: ESTATURA = 143.93 + 0.36 × PESO

4 DATOS EXTERNOS

Base de datos: EdadPesoGrasas.txt - Variables: Edad, Peso, Grasas en sangre

4.1 (38i) Cargar datos

grasas <- read.table('http://verso.mat.uam.es/~joser.berrendero/datos/EdadPesoGrasas.txt', 
                     header = TRUE)
names(grasas)
## [1] "peso"   "edad"   "grasas"
head(grasas)
##   peso edad grasas
## 1   84   46    354
## 2   73   20    190
## 3   65   52    405
## 4   70   30    263
## 5   76   57    451
## 6   69   25    302

4.2 (39i) Matriz de Pares

pairs(grasas, main = "Matriz de Diagramas - Datos de Grasas", 
      col = "#D9C5A0", pch = 19, cex = 0.8)

4.3 (40i) Matriz de Correlación

print(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

4.4 (41i) Regresión GRASAS ~ EDAD

reg_grasas <- lm(grasas ~ edad, data = grasas)
reg_grasas
## 
## Call:
## lm(formula = grasas ~ edad, data = grasas)
## 
## Coefficients:
## (Intercept)         edad  
##     102.575        5.321

4.5 (42i) Resumen

summary(reg_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

4.6 (43i) Gráfico

plot(grasas$edad, grasas$grasas, xlab = 'Edad (años)', ylab = 'Grasas (mg/dL)',
     main = "Recta de Regresión - Grasas vs Edad", 
     col = "#D9C5A0", pch = 19, cex = 2)

abline(reg_grasas, col = "#7A94B8", lwd = 4)

legend("topleft", legend = "Tendencia lineal", col = "#7A94B8", lwd = 4, bty = "n")

Beige para salud denota calidez así como cuidado. Azul slate en tendencia continúa siendo símbolo de estabilidad en relaciones biomédicas.

4.7 (44i) Predicciones

nuevas_edades <- data.frame(edad = seq(30, 50, by = 2))
predicciones <- predict(reg_grasas, nuevas_edades)

tabla <- data.frame(Edad = nuevas_edades$edad, Grasas = round(predicciones, 2))
print(tabla)
##    Edad Grasas
## 1    30 262.20
## 2    32 272.84
## 3    34 283.48
## 4    36 294.12
## 5    38 304.76
## 6    40 315.40
## 7    42 326.04
## 8    44 336.68
## 9    46 347.33
## 10   48 357.97
## 11   50 368.61

Estas predicciones estiman valores esperados de grasas según modelo. Recuerda que son extrapolaciones basadas en tendencia histórica así como pueden tener límites de confiabilidad.