Entrega final (Probabilidad)

Musica de ambiente:

Introducción

Este trabajo analiza la información de 315 encuestados en Bogotá sobre el tiempo dedicado a distintas actividades de ocio (internet, lectura, celular, televisión, deporte y aire libre), junto con variables demográficas como género, edad y estrato. El objetivo es describir el comportamiento de las principales variables y contrastar diferencias entre grupos, aplicando medidas descriptivas (tendencia central, dispersión, percentiles y forma), intervalos de confianza para medias y proporciones, y pruebas de hipótesis para comparar medias, varianzas y proporciones según lo solicitan los ejercicios.

En los puntos que exigen muestreo, se trabaja con muestras aleatorias de tamaño 69 y 81 usando semillas fijadas para garantizar reproducibilidad. Cuando corresponde, se verifica la idoneidad de los supuestos (normalidad y homogeneidad de varianzas) y, si es necesario, se apoyan las conclusiones con alternativas no paramétricas o métodos robustos. Los resultados se presentan con p‑values y intervalos de confianza, priorizando interpretaciones claras sobre la magnitud y la dirección de los efectos observados.

# --- Paquetes ----
library(readxl)
library(dplyr)
library(janitor)
library(ggplot2)
library(moments)     # skewness() y kurtosis()
library(knitr)
library(scales)
library(boot)
library(car)        # leveneTest
library(effsize)    # cliff.delta

# --- Cargar datos ----
ruta <- "base_encuesta_habitos.xlsx"

df <- read_excel(ruta) |>
  clean_names()

# Vector de análisis
x <- df$tiempo_internet |> as.numeric() |> na.omit()

length(x)

## [1] 315

Punto 1 — tiempo_internet: descriptivo completo

Se caracteriza la variable tiempo en internet (horas/día) mediante un resumen numérico completo: tendencia central (media, mediana y una moda aproximada), dispersión (varianza, desviación estándar, rango, IQR y MAD), posición (percentiles 1, 5, 10, 25, 50, 75, 90, 95 y 99) y forma (asimetría y curtosis). Además, se identifica la presencia de atípicos con los umbrales de Tukey y se evalúa la normalidad mediante Shapiro–Wilk y Q–Q plot. Las gráficas (histograma con densidad, ECDF, boxplot y Q–Q) complementan la lectura para juzgar simetría, colas y valores extremos. Con este bloque se obtiene una visión clara de la magnitud típica, la variabilidad y la regularidad de la distribución, base para decidir la idoneidad de métodos paramétricos en los puntos siguientes.

1.1 Medidas numéricas

# --- Medidas de tendencia central y variabilidad ----
n        <- length(x)
media    <- mean(x)
mediana  <- median(x)

# "Moda" en continuas no es estable; usamos una aproximación discreta redondeando a 0.1h
# (documentamos esta decisión en el texto)
mode_approx <- x |>
  round(1) |>
  (\(z) z[which.max(tabulate(match(z, unique(z))))])()

varianza <- var(x)
sdx      <- sd(x)
rango    <- diff(range(x))
minx     <- min(x)
maxx     <- max(x)

# Posición
probs <- c(.01,.05,.10,.25,.50,.75,.90,.95,.99)
perc  <- quantile(x, probs = probs, names = FALSE)

# Forma
asime  <- skewness(x)                 # asimetría de Fisher-Pearson
curt_e <- kurtosis(x) - 3             # exceso de curtosis (0 en Normal)

# Outliers de Tukey
Q1  <- quantile(x, .25)
Q3  <- quantile(x, .75)
IQR <- Q3 - Q1
fence_low    <- Q1 - 1.5*IQR
fence_high   <- Q3 + 1.5*IQR
ext_low      <- Q1 - 3*IQR
ext_high     <- Q3 + 3*IQR
out_mask     <- x < fence_low | x > fence_high
n_out        <- sum(out_mask)
n_out_ext    <- sum(x < ext_low | x > ext_high)

# Normalidad (guía, no dogma)
sh <- shapiro.test(x)

# Tablas para reporte
tabla_resumen <- tibble::tibble(
  medida = c("n", "media", "mediana", "moda_aprox(0.1h)", 
             "varianza", "desv_est", "rango", "min", "max",
             "IQR", "MAD", "skewness", "kurtosis_exceso",
             "Shapiro_W", "Shapiro_p"),
  valor  = c(n, media, mediana, mode_approx,
             varianza, sdx, rango, minx, maxx,
             IQR, median(abs(x - mediana)), asime, curt_e,
             unname(sh$statistic), sh$p.value)
)

tabla_percentiles <- tibble::tibble(
  percentil = percent(probs),
  valor     = as.numeric(perc)
)

tabla_outliers <- tibble::tibble(
  Q1 = Q1, Q3 = Q3, IQR = IQR,
  fence_baja = fence_low, fence_alta = fence_high,
  extremo_bajo = ext_low, extremo_alto = ext_high,
  n_outliers = n_out, n_outliers_extremos = n_out_ext
)

kable(tabla_resumen, digits = 2, caption = "Resumen numérico — tiempo_internet")

Resumen numérico — tiempo_internet

medida	valor
n	315.00
media	2.83
mediana	2.90
moda_aprox(0.1h)	4.00
varianza	0.65
desv_est	0.81
rango	4.50
min	0.70
max	5.20
IQR	1.10
MAD	0.50
skewness	-0.15
kurtosis_exceso	-0.24
Shapiro_W	0.99
Shapiro_p	0.16

kable(tabla_percentiles, digits = 2, caption = "Percentiles de tiempo_internet")

Percentiles de tiempo_internet

percentil	valor
1%	1.00
5%	1.40
10%	1.74
25%	2.30
50%	2.90
75%	3.40
90%	3.86
95%	4.10
99%	4.59

kable(tabla_outliers, digits = 2, caption = "Umbrales de Tukey y conteo de atípicos")

Umbrales de Tukey y conteo de atípicos

Q1	Q3	IQR	fence_baja	fence_alta	extremo_bajo	extremo_alto	n_outliers	n_outliers_extremos
2.3	3.4	1.1	0.65	5.05	-1	6.7	1	0

1.2 Gráficas

# Histograma + densidad
ggplot(mapping = aes(x = x)) +
  geom_histogram(aes(y = after_stat(density)), bins = 25, color = "navy", fill = "blue", alpha = 0.35) +
  geom_density(linewidth = 0.8, color = "navy") +
  labs(title = "Tiempo en internet — Histograma y densidad",
       x = "Horas por día", y = "Densidad")+
  theme_minimal()

# ECDF
ggplot(mapping = aes(x = x)) +
  stat_ecdf(geom = "step", color = "navy") +
  labs(title = "Tiempo en internet — ECDF",
       x = "Horas por día", y = "F(x)")+
  theme_minimal()

# Boxplot
ggplot(mapping = aes(y = x)) +
  geom_boxplot(outlier.alpha = 0.7,color = "navy", fill = "blue", alpha = 0.35) +
  stat_summary(aes(x = 0, y = x), fun = mean, geom = "point", shape = 24, size = 2.8,color = "navy", fill = "blue") +
  labs(title = "Tiempo en internet — Boxplot",
       y = "Horas por día")+
  theme_minimal()

# Q–Q plot (Normal)
ggplot(mapping = aes(sample = x)) +
  stat_qq(color = "navy") +
  stat_qq_line(color = "navy") +
  labs(title = "Tiempo en internet — Q–Q plot (Normal)",
       x = "Cuantiles teóricos", y = "Cuantiles muestrales")+
  theme_minimal()

1.3 Interpretación

• Magnitud típica. La media es 2.83 h/día y la mediana 2.9 h/día, prácticamente iguales, lo que sugiere simetría global. El histograma y la ECDF muestran concentración alrededor de 2.9–3 h.

• Dispersión. La desviación estándar es 0.81 h y el IQR 1.1 h, por lo que la mitad central de las personas se ubica entre 2.3 y 3.4 h/día. El rango total va de 0.7 a 5.2 h/día, con variabilidad moderada. La MAD = 0.5 h respalda que la dispersión no está dominada por valores extremos.

• Posición (percentiles). El 50% dedica ≤ 2.9 h, el 90% ≤ 3.86 h, el 95% ≤ 4.1 h y el 99% ≤ 4.59 h. El uso intensivo existe pero está concentrado en una fracción pequeña de la población.

• Forma. La asimetría es -0.15 (ligera) y la curtosis (exceso) -0.24 (levemente platicúrtica). El Q–Q plot es casi lineal y el Shapiro–Wilk arroja W = 0.99; p = 0.161, por lo que no se rechaza normalidad. En conjunto, el comportamiento es cercano a Normal, apropiado para métodos paramétricos.

• Atípicos. Con los umbrales de Tukey [0.65, 5.05] se detectan 1 observaciones fuera del rango (principalmente por arriba) y 0 atípicos extremos. Su impacto sobre la media es mínimo dada su rareza.

• Moda aproximada. El valor 4 h proviene de una aproximación por redondeo (0.1 h); es informativo pero no debe sobre‑interpretarse en variables continuas.

Conclusión. El tiempo en internet se concentra alrededor de 2.83–2.9 horas diarias, con dispersión moderada y muy pocos casos por encima de 5.05 h. La cercanía a la normalidad y la escasez de atípicos permiten emplear intervalos y pruebas paramétricas con confianza, complementándolos con alternativas robustas cuando sea pertinente.

Punto 2 — Muestra aleatoria de 69 observaciones

Se seleccionó una muestra aleatoria simple de 69 personas a partir de la base de 315 registros. Para garantizar reproducibilidad, se fijó la semilla con los últimos dígitos de los documentos del grupo: 5633766. El muestreo se realizó sin reemplazo, tratando cada fila como una unidad muestral independiente. El resultado es el objeto m69 con 69 observaciones, a partir del cual se resuelven los Puntos 3, 4 y 5.

# --- Semilla documentada ---
seed69 <- 5633766
set.seed(seed69)

# --- Muestreo sin reemplazo de 69 filas ---
# Usamos la fila como unidad de muestreo; preferimos el índice de fila para reproducibilidad.
idx_69 <- sample(seq_len(nrow(df)), size = 69, replace = FALSE)
m69 <- df[idx_69, ] |> mutate(.row_index = idx_69)

# Resúmenes de composición de la muestra
tab_genero  <- m69 |> count(genero, name = "n")
tab_estrato <- m69 |> count(estrato, name = "n") |> arrange(estrato)
res_edad    <- m69 |> summarise(n = n(),
                                media = mean(edad, na.rm = TRUE),
                                sd = sd(edad, na.rm = TRUE),
                                min = min(edad, na.rm = TRUE),
                                p25 = quantile(edad, .25, na.rm = TRUE),
                                mediana = median(edad, na.rm = TRUE),
                                p75 = quantile(edad, .75, na.rm = TRUE),
                                max = max(edad, na.rm = TRUE))

kable(tab_genero, caption = "Composición por género en la muestra de 69")

Composición por género en la muestra de 69

genero	n
F	41
M	28

kable(tab_estrato, caption = "Composición por estrato en la muestra de 69")

Composición por estrato en la muestra de 69

estrato	n
1	18
2	20
3	17
4	10
5	1
6	3

kable(round(res_edad, 3), caption = "Resumen de edad en la muestra de 69")

Resumen de edad en la muestra de 69

n	media	sd	min	p25	mediana	p75	max
69	35.783	10.069	18	30	35	42	61

# --- Objetos de trabajo para los puntos 3–5 ---
# Punto 3: vector de lectura
y_lectura_69 <- m69$tiempo_lectura |> as.numeric()

# Punto 4: aire libre por género (solo M/F)
m69_MF <- m69 |> filter(genero %in% c("M","F"))
gM_aire <- m69_MF |> filter(genero == "M") |> pull(tiempo_aire_libre) |> as.numeric()
gF_aire <- m69_MF |> filter(genero == "F") |> pull(tiempo_aire_libre) |> as.numeric()

# Punto 5: celular por género
gM_cel <- m69_MF |> filter(genero == "M") |> pull(tiempo_celular) |> as.numeric()
gF_cel <- m69_MF |> filter(genero == "F") |> pull(tiempo_celular) |> as.numeric()

# Chequeo de tamaños (útil para interpretación)
sizes_p3_p5 <- tibble::tibble(
  bloque = c("P3_lectura", "P4_aire_M", "P4_aire_F", "P5_cel_M", "P5_cel_F"),
  n      = c(length(y_lectura_69), length(gM_aire), length(gF_aire),
             length(gM_cel), length(gF_cel))
)
kable(sizes_p3_p5, caption = "Tamaños muestrales relevantes para P3–P5")

Tamaños muestrales relevantes para P3–P5

bloque	n
P3_lectura	69
P4_aire_M	28
P4_aire_F	41
P5_cel_M	28
P5_cel_F	41

Interpretación

La muestra aleatoria de 69 personas quedó ligeramente desbalanceada por género, con
Mujeres = 41 y Hombres = 28 (41 vs. 28).
Este tamaño es suficiente para aplicar las comparaciones pedidas en los Puntos 4 y 5 (Welch, Mann–Whitney y Levene), aunque el menor n en hombres implica que diferencias pequeñas podrían no detectarse.

Por estrato socioeconómico se observa cobertura en todos los niveles, pero con muy pocos casos en los estratos altos (E5 = 1, E6 = 3). En particular, estrato 6 tiene 3 observaciones, lo que limita cualquier comparación dentro de esta muestra. Por ello, en el Punto 8 se reporta la comparación E1 vs. E6 usando la base completa, donde sí hay información suficiente para estimar la diferencia con mayor precisión.

La edad presenta una distribución centrada en la adultez: media = 35.78 años, mediana = 35, IQR = 12 (P25 = 30, P75 = 42), con rango 18–61. No se evidencian edades extremas que comprometan los análisis.

Para los bloques siguientes, los tamaños efectivos son:
- P3 (lectura): 69 observaciones.
- P4 (aire libre): H = 28, M = 41.
- P5 (celular): H = 28, M = 41.

En síntesis, la muestra es apta para los ejercicios 3–5. Debe tenerse en cuenta que el desbalance por género y los conteos reducidos en estratos altos reducen la potencia para detectar efectos pequeños; por ello se acompañan las pruebas con intervalos de confianza y tamaños de efecto, y en el Punto 8 se recurre a la base completa para una comparación más sólida entre estratos extremos.

Punto 3 — IC 95% para la media de tiempo_lectura (muestra de 69)

En este punto se estima la media poblacional del tiempo diario dedicado a la lectura a partir de la muestra de 69 observaciones. Para ello se construirá un intervalo de confianza al 95% usando el procedimiento t de Student: \[ \bar{x} \;\pm\; t_{0.975,\;n-1}\;\frac{s}{\sqrt{n}}, \] donde \(\bar{x}\) es la media muestral, \(s\) la desviación estándar y \(n\) el tamaño de la muestra. Como apoyo, se verificará la normalidad aproximada (Shapiro–Wilk y Q–Q plot); si la distribución muestra asimetrías o colas marcadas, se reportará además un intervalo Bootstrap (BCa) para contrastar la estabilidad de la estimación.

La interpretación se presentará en términos sustantivos (horas/día): se indicará el rango plausible para la media poblacional bajo los supuestos del método y se comentará el margen de error, así como la coherencia entre el intervalo paramétrico y el intervalo robusto.

# Vector de interés (definido en el Punto 2)
y <- y_lectura_69 |> as.numeric() |> na.omit()

# --- Estadísticos básicos ---
n   <- length(y)
m   <- mean(y)
sd_ <- sd(y)
se  <- sd_ / sqrt(n)

# --- IC 95% t-Student ---
tcrit <- qt(0.975, df = n - 1)
ic_t  <- c(m - tcrit * se, m + tcrit * se)

# --- Diagnóstico de normalidad (guía) ---
sh <- shapiro.test(y)

# --- IC 95% Bootstrap (BCa) ---
set.seed(seed69)   # usar la misma semilla base para reproducibilidad
boot_stat <- function(data, idx) mean(data[idx])
bt <- boot(y, statistic = boot_stat, R = 20000)
ci_bca <- boot.ci(bt, type = "bca")$bca[4:5]  # columnas 4 y 5 son límites inf/sup

# Tabla de resultados
res_p3 <- tibble::tibble(
  n = n,
  media = m,
  sd = sd_,
  se = se,
  IC95_t_inf = ic_t[1],
  IC95_t_sup = ic_t[2],
  IC95_bca_inf = ci_bca[1],
  IC95_bca_sup = ci_bca[2],
  Shapiro_W = unname(sh$statistic),
  Shapiro_p = sh$p.value
)

kable(round(res_p3, 4), caption = "IC 95% para la media de tiempo de lectura (muestra n=69)")

IC 95% para la media de tiempo de lectura (muestra n=69)

n	media	sd	se	IC95_t_inf	IC95_t_sup	IC95_bca_inf	IC95_bca_sup	Shapiro_W	Shapiro_p
69	1.042	0.7533	0.0907	0.8611	1.223	0.8732	1.2261	0.9547	0.0138

# Gráficas de respaldo
# Histograma + densidad
ggplot(data.frame(y = y), aes(x = y)) +
  geom_histogram(aes(y = after_stat(density)), bins = 20, color = "navy", fill = "blue", alpha = 0.35) +
  geom_density(linewidth = 0.8, color = "navy") +
  labs(title = "Tiempo de lectura — Histograma y densidad (muestra 69)",
       x = "Horas por día", y = "Densidad") +
  theme_minimal()

# Q–Q plot
ggplot(data.frame(y = y), aes(sample = y)) +
  stat_qq(color = "navy") + stat_qq_line(color = "navy") +
  labs(title = "Tiempo de lectura — Q–Q plot vs Normal",
       x = "Cuantiles teóricos", y = "Cuantiles muestrales") +
  theme_minimal()

Interpretación

• Con n = 69 observaciones, la media muestral del tiempo diario de lectura es 1.042 h/día con desviación estándar 0.753 h y error estándar 0.091 h.

• El IC 95% (t de Student) para la media poblacional es
  [0.861, 1.223] h/día, con un margen ≈ 0.181 h alrededor de la media.

• Dado que el test de Shapiro–Wilk entrega W = 0.9547; p = 0.0138, existe cierta desviación de normalidad (cola y acumulación de valores bajos), visible en el histograma y el Q–Q plot. No obstante, con 69 casos el procedimiento t suele ser estable; por eso se contrasta con un método robusto.

• El IC 95% Bootstrap (BCa) resulta [0.873, 1.226] h/día, muy cercano al intervalo t. La coincidencia entre ambos métodos indica que la estimación es consistente pese a la ligera no normalidad.

Conclusión. Con un 95% de confianza, la media poblacional del tiempo diario de lectura se ubica aproximadamente entre 0.86 y 1.22 horas. En términos prácticos, el promedio está cerca de 1.04 h/día. Aunque la distribución no es perfectamente normal, la concordancia con el intervalo bootstrap respalda la robustez del resultado.

Punto 4 — ¿Diferencia en tiempo_aire_libre entre hombres y mujeres?

En este punto se evalúa si el tiempo promedio dedicado a actividades al aire libre difiere entre hombres (M) y mujeres (F). Se planteará el contraste \[ H_0:\ \mu_M-\mu_F=0 \quad\text{vs}\quad H_1:\ \mu_M-\mu_F\neq 0, \] y se aplicará la prueba t de Welch (no asume varianzas iguales) como procedimiento principal. Se reportará el estadístico t, los grados de libertad de Welch, el p‑valor y el intervalo de confianza del 99% para la diferencia \((\mu_M-\mu_F)\).

Para respaldar la decisión se revisarán los supuestos (normalidad por grupo y homogeneidad de varianzas con Levene/Brown–Forsythe) y se incluirá la alternativa no paramétrica (Mann–Whitney) en caso de asimetrías o atípicos. Además, se informarán tamaños de efecto (Hedges g y Cliff’s \(\delta\)) para valorar la magnitud práctica de cualquier diferencia encontrada.

# Datos por género (del Punto 2)
gM <- gM_aire
gF <- gF_aire

nM <- length(gM); nF <- length(gF)

# Estadísticos básicos
meanM <- mean(gM); meanF <- mean(gF)
varM  <- var(gM);  varF  <- var(gF)
diff_mean <- meanM - meanF

# Welch t-test (dos colas), IC 99% para la diferencia (M - F)
t_welch <- t.test(gM, gF, var.equal = FALSE, conf.level = 0.99)
t_stat  <- unname(t_welch$statistic)
df_w    <- unname(t_welch$parameter)
p_w     <- t_welch$p.value
ic99    <- unname(t_welch$conf.int)   # ya es para (mean of x - mean of y) = M - F

# Mann–Whitney
mw <- wilcox.test(gM, gF, exact = FALSE, alternative = "two.sided")
u_p <- mw$p.value

# Levene (varianzas iguales?) — versión con medianas
df_lv <- data.frame(
  y = c(gM, gF),
  genero = factor(c(rep("M", nM), rep("F", nF)))
)
lev <- leveneTest(y ~ genero, data = df_lv, center = "median")

# Tamaños de efecto
# Hedges g
hedges_g <- {
  n1 <- nM; n2 <- nF
  s1 <- varM; s2 <- varF
  sp <- sqrt(((n1 - 1) * s1 + (n2 - 1) * s2) / (n1 + n2 - 2))
  d  <- (meanM - meanF) / sp
  J  <- 1 - (3 / (4 * (n1 + n2) - 9))
  d * J
}

# Cliff's delta
cd <- cliff.delta(gM, gF)  # devuelve estimate y conf.int (95% por defecto)
cd_est <- unname(cd$estimate)
cd_magn <- cd$magnitude

# Resumen en tabla
res_p4 <- tibble::tibble(
  n_M = nM, n_F = nF,
  media_M = meanM, media_F = meanF,
  diff_M_menos_F = diff_mean,
  t_Welch = t_stat, df_Welch = df_w, p_Welch = p_w,
  IC99_inf = ic99[1], IC99_sup = ic99[2],
  p_MannWhitney = u_p,
  Levene_F = lev[1, "F value"], Levene_p = lev[1, "Pr(>F)"],
  Hedges_g = hedges_g,
  Cliffs_delta = cd_est, Cliffs_mag = as.character(cd_magn)
)

# ---- Tablas para impresión (formateadas), sin tocar res_p4 ----
res_p4_A <- res_p4 |>
  dplyr::select(n_M, n_F, media_M, media_F, diff_M_menos_F, IC99_inf, IC99_sup) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 3)))

res_p4_B <- res_p4 |>
  dplyr::select(t_Welch, df_Welch, p_Welch, p_MannWhitney,
                Levene_F, Levene_p, Hedges_g, Cliffs_delta, Cliffs_mag) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 4)))

knitr::kable(
  res_p4_B,
  caption = "Punto 4 — Pruebas (Welch, Mann–Whitney, Levene) y tamaños de efecto",
  digits = 2
)

Punto 4 — Pruebas (Welch, Mann–Whitney, Levene) y tamaños de efecto

t_Welch	df_Welch	p_Welch	p_MannWhitney	Levene_F	Levene_p	Hedges_g	Cliffs_delta	Cliffs_mag
1.01	60.1	0.32	0.25	0.56	0.46	0.24	0.16	small

# Gráficas de apoyo
# Densidades y boxplot
df_plot <- df_lv

ggplot(df_plot, aes(x = genero, y = y)) +
  geom_boxplot(outlier.alpha = 0.7,color = "navy", fill = "blue", alpha = 0.35) +
  stat_summary(fun = mean, geom = "point", shape = 24, size = 2.8, color = "navy", fill = "blue") +
  labs(title = "Tiempo al aire libre por género — Boxplot",
       x = "Género", y = "Horas por día") +
  theme_minimal()

ggplot(df_plot, aes(x = y, fill = genero)) +
  geom_density(alpha = 0.35, color="navy") +
  scale_fill_manual(values = c("F" = "gold", "M" = "blue")) +
  labs(title = "Tiempo al aire libre — Densidades por género",
       x = "Horas por día", y = "Densidad") +
  theme_minimal()

Interpretación

• Tamaños y medias. Hombres (n = 28) y mujeres (n = 41) presentan medias muy próximas:
  M = 1.54 h/día y F = 1.36 h/día.
  La diferencia estimada (M − F) es 0.18 h.

• Prueba principal (Welch). \(t = 1.01\), df ≈ 60.1, p = 0.318.
  Con este resultado no se rechaza \(H_0\); no hay evidencia estadística de que los promedios difieran.

• IC 99% para la diferencia (M − F). [-0.29, 0.65] h.
  El intervalo incluye 0 y es relativamente estrecho alrededor de valores pequeños, lo que sugiere que, si existiera una diferencia real, sería pequeña en términos prácticos.

• Robustez. La alternativa Mann–Whitney arroja p = 0.253, consistente con Welch.
  La prueba de Levene indica p = 0.458, por lo que no se evidencia desigualdad de varianzas entre grupos.

• Tamaño de efecto. Hedges g = 0.24 y Cliff’s δ = 0.16 (small). Ambos indican un efecto pequeño.

Conclusión. Con la muestra analizada, no se encuentra diferencia significativa en el tiempo promedio dedicado a actividades al aire libre entre hombres y mujeres. El IC 99% centrado cerca de cero y los tamaños de efecto pequeños respaldan que cualquier diferencia, de existir, sería de magnitud reducida.

Punto 5 — ¿Diferencia en la variabilidad de tiempo_celular por género?

Aquí se compara la variabilidad del tiempo diario dedicado al celular entre hombres (M) y mujeres (F). El parámetro de interés es la razón de varianzas \[ R=\frac{\sigma_M^2}{\sigma_F^2}. \] Se aplicarán dos enfoques:

1. Prueba F clásica para varianzas (sensible a no normalidad).
   Estadístico: \[ F=\frac{s_M^2}{s_F^2},\qquad F\sim F_{\;n_M-1,\;n_F-1}\ \text{bajo }H_0:\sigma_M^2=\sigma_F^2. \] También se reportará el IC del 95% para \(R\) basado en la distribución F.

2. Pruebas robustas de igualdad de dispersión: Levene y Brown–Forsythe (centro en la mediana). Estas no requieren normalidad y son preferibles si se observan asimetrías o atípicos.

De apoyo, se inspeccionará la normalidad por grupo (Shapiro–Wilk y Q–Q plots). Si los supuestos normales no son convincentes, la decisión se basará en Brown–Forsythe y se complementará con un intervalo bootstrap para \(R\).

La interpretación se presentará indicando qué grupo es más variable, la magnitud de esa diferencia (valor de \(R\) e intervalos) y qué prueba gobierna la conclusión.

# --- Datos por género (definidos en Punto 2) ---
xM <- gM_cel
xF <- gF_cel

nM <- length(xM); nF <- length(xF)
varM <- var(xM);   varF <- var(xF)
sdM  <- sd(xM);    sdF  <- sd(xF)

# --- Diagnóstico de normalidad por grupo ---
sh_M <- shapiro.test(xM)
sh_F <- shapiro.test(xF)

# --- F-test clásico para razón de varianzas (M/F) ---
#   Importante: es MUY sensible a no-normalidad. Reportamos pero no lo usamos como único criterio.
f_stat <- varM / varF
df1 <- nM - 1
df2 <- nF - 1
# Bilateral: p = 2*min(P(F<=f), P(F>=f))
p_f_upper <- 1 - pf(f_stat, df1, df2)
p_f <- 2 * min(p_f_upper, 1 - p_f_upper)

# IC 95% para la razón sigma_M^2 / sigma_F^2 con F paramétrica
alpha <- 0.05
lower_f <- f_stat / qf(1 - alpha/2, df1, df2)
upper_f <- f_stat / qf(alpha/2, df1, df2)

# --- Pruebas robustas de igualdad de varianzas ---
df_lev <- data.frame(
  y = c(xM, xF),
  genero = factor(c(rep("M", nM), rep("F", nF)))
)
# Levene con media (clásico) y mediana (Brown–Forsythe)
lev_mean   <- leveneTest(y ~ genero, data = df_lev, center = "mean")
lev_median <- leveneTest(y ~ genero, data = df_lev, center = "median")

# --- Bootstrap robusto para la razón de varianzas sigma_M^2 / sigma_F^2 ---
set.seed(seed69)
B <- 20000
ratios <- replicate(B, {
  xm <- sample(xM, size = nM, replace = TRUE)
  xf <- sample(xF, size = nF, replace = TRUE)
  var(xm) / var(xf)
})

ci_bt <- quantile(ratios, c(0.025, 0.975), na.rm = TRUE)
boot_ratio_inf <- unname(ci_bt[1])
boot_ratio_sup <- unname(ci_bt[2])

# --- Tabla de resultados ---
res_p5 <- tibble::tibble(
  n_M = nM, n_F = nF,
  sd_M = sdM, sd_F = sdF,
  var_M = varM, var_F = varF,
  ratio_var_MF = f_stat,
  F_df1 = df1, F_df2 = df2,
  F_p_bilateral = p_f,
  IC95_ratio_F_inf = lower_f,
  IC95_ratio_F_sup = upper_f,
  Levene_mean_F = as.numeric(lev_mean[1, "F value"]),
  Levene_mean_p = as.numeric(lev_mean[1, "Pr(>F)"]),
  Levene_median_F = as.numeric(lev_median[1, "F value"]),
  Levene_median_p = as.numeric(lev_median[1, "Pr(>F)"]),
  Shapiro_M_W = unname(sh_M$statistic),
  Shapiro_M_p = sh_M$p.value,
  Shapiro_F_W = unname(sh_F$statistic),
  Shapiro_F_p = sh_F$p.value,
  Boot_ratio_inf = boot_ratio_inf,
  Boot_ratio_sup = boot_ratio_sup
) 

# ---- Tablas divididas para impresión (sin alterar res_p5) ----

# A) Tamaños, dispersión y razones con IC (F y bootstrap)
res_p5_A <- res_p5 |>
  dplyr::select(
    n_M, n_F,
    sd_M, sd_F, var_M, var_F,
    ratio_var_MF,
    IC95_ratio_F_inf, IC95_ratio_F_sup,
    Boot_ratio_inf, Boot_ratio_sup
  ) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 4)))

# B) Pruebas y diagnósticos (F, Levene/BF, Shapiro)
res_p5_B <- res_p5 |>
  dplyr::select(
    F_df1, F_df2, F_p_bilateral,
    Levene_mean_F, Levene_mean_p,
    Levene_median_F, Levene_median_p,
    Shapiro_M_W, Shapiro_M_p,
    Shapiro_F_W, Shapiro_F_p
  ) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 4)))

knitr::kable(
  res_p5_A,
  caption = "Punto 5 — Tamaños, dispersión y razones de varianzas (IC F y bootstrap)",
  digits = 2
)

Punto 5 — Tamaños, dispersión y razones de varianzas (IC F y bootstrap)

n_M	n_F	sd_M	sd_F	var_M	var_F	ratio_var_MF	IC95_ratio_F_inf	IC95_ratio_F_sup	Boot_ratio_inf	Boot_ratio_sup
28	41	0.69	0.71	0.48	0.51	0.94	0.48	1.95	0.41	1.93

knitr::kable(
  res_p5_B,
  caption = "Punto 5 — Pruebas (F, Levene/Brown–Forsythe) y diagnósticos de normalidad",
  digits = 2
)

Punto 5 — Pruebas (F, Levene/Brown–Forsythe) y diagnósticos de normalidad

F_df1	F_df2	F_p_bilateral	Levene_mean_F	Levene_mean_p	Levene_median_F	Levene_median_p	Shapiro_M_W	Shapiro_M_p	Shapiro_F_W	Shapiro_F_p
27	40	0.88	0	0.95	0	0.98	0.96	0.3	0.97	0.46

# --- Gráficas de apoyo ---
# Boxplots lado a lado + densidades
ggplot(df_lev, aes(x = genero, y = y)) +
  geom_boxplot(outlier.alpha = 0.7,color = "navy", fill = "blue", alpha = 0.35) +
  stat_summary(fun = mean, geom = "point", shape = 24, size = 2.8,  color = "navy", fill = "blue") +
  labs(title = "Tiempo en celular — Boxplot por género",
       x = "Género", y = "Horas por día") +
  theme_minimal()

ggplot(df_lev, aes(x = y, fill = genero)) +
  geom_density(alpha = 0.35, color = "navy") +
  scale_fill_manual(values = c("F" = "gold", "M" = "blue")) +
  labs(title = "Tiempo en celular — Densidades por género",
       x = "Horas por día", y = "Densidad") +
  theme_minimal()

# Q–Q por grupo
ggplot(data.frame(x = xM), aes(sample = x)) +
  stat_qq(color = "navy") + stat_qq_line(color = "navy") +
  labs(title = "Q–Q plot Normal — Hombres (tiempo_celular)", x = "Teórico", y = "Muestral") +
  theme_minimal()

ggplot(data.frame(x = xF), aes(sample = x)) +
  stat_qq(color = "navy") + stat_qq_line(color = "navy") +
  labs(title = "Q–Q plot Normal — Mujeres (tiempo_celular)", x = "Teórico", y = "Muestral") +
  theme_minimal()

Interpretación

• Dispersión por género. Las desviaciones estándar son M = 0.691 h y F = 0.713 h
  (varianzas M = 0.4781, F = 0.5085).
  La razón de varianzas \(R=\sigma_M^2/\sigma_F^2\) es 0.94, es decir, ligeramente < 1, lo que indica variabilidad un poco mayor en mujeres, pero de magnitud mínima.

• Prueba F (paramétrica). p = 0.8805 con df = (27, 40).
  El IC 95% para \(R\) es [0.477, 1.946],
  que incluye 1, por lo que no hay evidencia de diferencia en varianzas.

• Robustez (Levene / Brown–Forsythe).

  • Levene (media): p = 0.9488
    
  • Brown–Forsythe (mediana): p = 0.9766
    Ambos resultados no significativos confirman la igualdad de dispersión.

• Normalidad por grupo (diagnóstico).
  Shapiro–Wilk H: p = 0.2985; M: p = 0.4555.
  No se detectan desviaciones graves; aun así, la decisión se apoya en las pruebas robustas.

• Bootstrap para \(R\). El IC 95% bootstrap es [0.412, 1.928],
  también contiene 1, reforzando la conclusión.

Conclusión. No se encuentra diferencia estadísticamente significativa en la variabilidad del tiempo dedicado al celular entre hombres y mujeres. Aunque las mujeres muestran una varianza levemente mayor, la razón \(R≈0.94\) y todos los intervalos de confianza indican que la diferencia es pequeña y compatible con igualdad. La conclusión queda gobernada por Brown–Forsythe (robusta) y es coherente con el F‑test y el bootstrap.

Punto 6 — ¿La proporción >3 h/día en internet es la misma en H y M? (α=0.01)

En este punto se toma una muestra aleatoria de 81 observaciones (semilla 6673365) y se define la variable binaria
\[ \texttt{gt3\_internet}= \begin{cases} 1,& \text{si } \texttt{tiempo\_internet} > 3\;\text{h/día}\\ 0,& \text{en otro caso.} \end{cases} \] El objetivo es contrastar si la proporción de personas con uso intensivo (> 3 h/día) es igual en hombres y mujeres: \[ H_0: p_H = p_M \quad\text{vs}\quad H_1: p_H \ne p_M, \] con nivel de significancia \(\alpha = 0.01\).

Se aplicará la prueba z de dos proporciones (con varianza agrupada) y, como respaldo, el chi‑cuadrado de independencia 2×2 y la prueba exacta de Fisher cuando los conteos esperados sean bajos. Además, se calculará el odds ratio (OR) con su IC del 99%, para cuantificar la magnitud del efecto. Se verificará la condición de aproximación normal
\((n_g \hat p_g \ge 5\) y \(n_g(1-\hat p_g)\ge 5)\) y, si no se cumple, la decisión se basará en Fisher. La interpretación destacará tanto la decisión al 1% como la magnitud e incertidumbre del efecto estimado.

# --- Semilla derivada y muestreo n = 81 ---
seed81 <- 6673365   # reverso de 5633766, documentado
set.seed(seed81)

stopifnot(nrow(df) >= 81)
idx_81 <- sample(seq_len(nrow(df)), size = 81, replace = FALSE)
m81 <- df[idx_81, ] |> mutate(.row_index = idx_81)

# Guardar trazabilidad
readr::write_csv(m81 |> select(id, .row_index), "ids_muestra_81.csv")

# --- Definición binaria: gt3_internet = 1 si > 3 horas/día ---
m81 <- m81 |>
  mutate(gt3_internet = as.integer(tiempo_internet > 3))

# --- Tabla de conteos por género (solo M/F) ---
tab <- m81 |>
  filter(genero %in% c("M","F")) |>
  count(genero, gt3_internet, name = "n") |>
  tidyr::pivot_wider(names_from = gt3_internet,
                     values_from = n,
                     values_fill = 0) |>
  # columnas "0" y "1" para no/si >3h
  rename(n_leq3 = `0`, n_gt3 = `1`) |>
  arrange(factor(genero, levels = c("M","F")))

kable(tab, caption = "Tabla 2×2 por género (muestra n=81)")

Tabla 2×2 por género (muestra n=81)

genero	n_leq3	n_gt3
M	25	20
F	21	15

# --- Extraer conteos en el orden M, F ---
x1 <- tab$n_gt3[tab$genero == "M"]; n1 <- (tab$n_leq3 + tab$n_gt3)[tab$genero == "M"]
x2 <- tab$n_gt3[tab$genero == "F"]; n2 <- (tab$n_leq3 + tab$n_gt3)[tab$genero == "F"]

p1 <- x1 / n1
p2 <- x2 / n2

# --- Prueba z de dos proporciones con varianza agrupada (bilateral) ---
p_pool <- (x1 + x2) / (n1 + n2)
se_pool <- sqrt(p_pool * (1 - p_pool) * (1/n1 + 1/n2))
z_stat <- (p1 - p2) / se_pool
p_z <- 2 * (1 - pnorm(abs(z_stat)))

# --- Chi-cuadrado de independencia (equivalente) ---
mat_2x2 <- matrix(c(x1, n1 - x1, x2, n2 - x2), nrow = 2, byrow = TRUE,
                  dimnames = list(genero = c("M","F"),
                                  gt3 = c("Si","No")))
chisq <- suppressWarnings(chisq.test(mat_2x2, correct = FALSE))
p_chi2 <- chisq$p.value
X2_stat <- unname(chisq$statistic)

# --- Fisher exacto (respaldo cuando hay conteos bajos) ---
fish <- fisher.test(mat_2x2, alternative = "two.sided")
p_fisher <- fish$p.value

# --- OR y IC 99% (Haldane–Anscombe si hay ceros) ---
a <- x1; b <- n1 - x1
c <- x2; d <- n2 - x2
if (min(a,b,c,d) == 0) {
  a <- a + 0.5; b <- b + 0.5; c <- c + 0.5; d <- d + 0.5
}
OR <- (a*d)/(b*c)
alpha <- 0.01
z_crit <- qnorm(1 - alpha/2)
se_logOR <- sqrt(1/a + 1/b + 1/c + 1/d)
IC99_OR <- exp(log(OR) + c(-1,1) * z_crit * se_logOR)

# --- Condiciones de aproximación normal ---
cond_ok <- (n1*p1 >= 5) & (n1*(1-p1) >= 5) & (n2*p2 >= 5) & (n2*(1-p2) >= 5)

# --- Resumen en tabla ---
res_p6 <- tibble::tibble(
  n_M = n1, x_M = x1, p_hat_M = p1,
  n_F = n2, x_F = x2, p_hat_F = p2,
  diff_hat = p1 - p2,
  z_stat = z_stat, p_z = p_z,
  chi2_stat = X2_stat, p_chi2 = p_chi2,
  p_fisher = p_fisher,
  OR = OR, OR_99_lo = IC99_OR[1], OR_99_hi = IC99_OR[2],
  condiciones_normales = cond_ok
) 

# ---- Tablas divididas para impresión (sin alterar res_p6) ----

# A) Conteos, proporciones y diferencia puntual
res_p6_A <- res_p6 |>
  dplyr::select(
    n_M, x_M, p_hat_M,
    n_F, x_F, p_hat_F,
    diff_hat
  ) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 6)))

# B) Pruebas y tamaño de efecto (OR con IC 99%) + condiciones
res_p6_B <- res_p6 |>
  dplyr::select(
    z_stat, p_z,
    chi2_stat, p_chi2,
    p_fisher,
    OR, OR_99_lo, OR_99_hi,
    condiciones_normales
  ) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 6)))

knitr::kable(
  res_p6_A,
  caption = "Punto 6 — Conteos, proporciones y diferencia puntual",
  digits = 6
)

Punto 6 — Conteos, proporciones y diferencia puntual

n_M	x_M	p_hat_M	n_F	x_F	p_hat_F	diff_hat
45	20	0.444444	36	15	0.416667	0.027778

knitr::kable(
  res_p6_B,
  caption = "Punto 6 — Pruebas (z, χ², Fisher), OR e IC 99% y verificación de condiciones",
  digits = 6
)

Punto 6 — Pruebas (z, χ², Fisher), OR e IC 99% y verificación de condiciones

z_stat	p_z	chi2_stat	p_chi2	p_fisher	OR	OR_99_lo	OR_99_hi	condiciones_normales
0.250775	0.801988	0.062888	0.801988	0.825225	1.12	0.349625	3.587844	TRUE

Interpretación

• Proporciones muestrales.
  Hombres: \(\hat p_H=\) 0.4444 (20 de 45).
  Mujeres: \(\hat p_M=\) 0.4167 (15 de 36).
  Diferencia estimada: \(\hat p_H-\hat p_M=\) 0.0278.

• Prueba principal (z de dos proporciones, α = 0.01).
  \(z = 0.2508\), p = 0.802 → no rechazo H0 al 1%.
  El resultado indica que, con esta muestra, no hay evidencia suficiente para afirmar una diferencia al nivel de exigencia planteado.

• Pruebas de respaldo.
  \(\chi^2\) 2×2: p = 0.802.
  Fisher exacto: p = 0.8252.
  Ambas son consistentes con la decisión anterior.

• Magnitud del efecto.
  OR = 1.12, IC 99% = [0.35, 3.59].
  El intervalo incluye 1, por lo que la razón de momios es compatible con igualdad al 1%.
  Aun así, el valor puntual (OR > 1) sugiere que los hombres podrían tener mayor probabilidad de superar las 3 horas, pero la incertidumbre es amplia.

• Condiciones de aproximación normal.
  Criterios de conteos esperados: se cumplen; por ello la prueba z es válida y, en todo caso, el resultado concuerda con Fisher.

Conclusión. A \(\alpha = 0.01\) no se detecta una diferencia significativa entre géneros en la proporción de personas que dedican más de 3 horas/día a internet. El OR ≈ 1.12 con IC 99% amplio y que incluye 1 indica que, aunque la señal favorece a los hombres, la evidencia es insuficiente para una conclusión firme al 1%. Con tamaños muestrales moderados y efecto pequeño, se requeriría mayor n para aumentar la potencia y acotar la incertidumbre.

Punto 7 — IC 95% para la diferencia de proporciones (Newcombe–Wilson)

Aquí se construirá un intervalo de confianza del 95% para la diferencia \[ \Delta = p_H - p_M, \] donde \(p_H\) y \(p_M\) son las proporciones de hombres y mujeres que dedican más de 3 horas/día a internet (definidas en el Punto 6). Para evitar los sesgos del intervalo de Wald clásico, se utilizará el método de Newcombe (1998) basado en Wilson: primero se obtienen los intervalos Wilson independientes para \(p_H\) y \(p_M\), y luego se combinan como \[ \text{IC}_{95\%}(\Delta) = \big[\,L_H - U_M,\; U_H - L_M\,\big], \] donde \(L\) y \(U\) son los límites inferior y superior de cada intervalo Wilson.

Finalmente, se evaluará la consistencia con el Punto 6:
- Si el IC 95% incluye 0, el resultado es compatible con no encontrar diferencia significativa (especialmente al umbral más estricto \(\alpha=0.01\) usado antes).
- Si el IC 95% no incluye 0, habrá evidencia de diferencia al 5%, que podría no ser suficiente al 1% (criterio más exigente), lo cual también es coherente.

# Función Wilson
wilson_ci <- function(x, n, alpha = 0.05){
  z <- qnorm(1 - alpha/2)
  p <- x / n
  denom <- 1 + z^2 / n
  center <- (p + z^2/(2*n)) / denom
  half <- z * sqrt((p*(1-p)/n) + (z^2/(4*n^2))) / denom
  c(lower = center - half, upper = center + half)
}

ci1 <- wilson_ci(x1, n1, alpha = 0.05)  # Hombres
ci2 <- wilson_ci(x2, n2, alpha = 0.05)  # Mujeres

# Newcombe: IC para Δ = p1 - p2 es (l1 - u2, u1 - l2)
ic95_diff <- c(ci1["lower"] - ci2["upper"], ci1["upper"] - ci2["lower"])
diff_hat  <- (x1/n1) - (x2/n2)

res_p7 <- tibble::tibble(
  p1_hat = x1/n1,
  p2_hat = x2/n2,
  diff_hat = diff_hat,
  IC95_inf = ic95_diff[1],
  IC95_sup = ic95_diff[2]
) |>
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 6)))

kable(res_p7, caption = "Punto 7 — IC 95% para la diferencia de proporciones (Newcombe–Wilson)")

Punto 7 — IC 95% para la diferencia de proporciones (Newcombe–Wilson)

p1_hat	p2_hat	diff_hat	IC95_inf	IC95_sup
0.444444	0.416667	0.027778	-0.268608	0.316833

Interpretación

• Las proporciones estimadas son Hombres \(\hat p_H=\) 0.4444 y Mujeres \(\hat p_M=\) 0.4167.
  La diferencia puntual es \(\hat\Delta=\hat p_H-\hat p_M=\) 0.0278.

• El IC 95% (Newcombe–Wilson) para \(\Delta\) es
  [, -0.268608].
  Este intervalo incluye 0, por lo que al 5% la evidencia es compatible con igualdad de proporciones.

• Consistencia con el Punto 6. En el ejercicio anterior, con \(\alpha=0.01\) no se rechazó \(H_0\). El hecho de que el IC 95% para \(\Delta\) contenga 0 es coherente con esa conclusión más estricta: la diferencia observada es pequeña y la incertidumbre, con el tamaño muestral disponible, permite valores positivos y negativos.

Conclusión. Con los datos de la muestra, la diferencia en la proporción de personas que superan 3 h/día en internet entre hombres y mujeres es pequeña (0.028) y el IC 95% admite tanto ausencia de diferencia como efectos moderados en cualquiera de los sentidos; por tanto, los resultados no respaldan afirmar una brecha clara entre géneros.

Punto 8 — Lectura: Estrato 1 vs 6

Se evaluará si el tiempo promedio de lectura (horas/día) difiere entre los estratos 1 y 6. El contraste principal será \[ H_0:\ \mu_{E1}=\mu_{E6}\quad \text{vs}\quad H_1:\ \mu_{E1}\neq\mu_{E6}, \] aplicando la prueba t de Welch (no asume varianzas iguales) y reportando el intervalo de confianza del 95% para la diferencia \(\mu_{E1}-\mu_{E6}\). Se revisarán los supuestos (normalidad por grupo y homogeneidad de varianzas con Levene/Brown–Forsythe) y, como respaldo, se incluirá la prueba no paramétrica de Mann–Whitney.

Dado que el estrato 6 suele tener pocos casos, primero se verificará la disponibilidad en la muestra de 69; si no hay observaciones suficientes para alguno de los grupos, se realizará la comparación con la base completa. Además, se informarán tamaños de efecto (Hedges g y Cliff’s \(\delta\)) y, para robustez, un IC bootstrap para la diferencia de medias. La interpretación destacará tanto la evidencia estadística como la magnitud práctica de la diferencia observada.

# --- 1) Con la muestra de 69 (si es posible) -------------------------------
e1_69 <- m69 %>% filter(estrato == 1) %>% pull(tiempo_lectura) %>% as.numeric()
e6_69 <- m69 %>% filter(estrato == 6) %>% pull(tiempo_lectura) %>% as.numeric()

n1_69 <- length(e1_69); n6_69 <- length(e6_69)

disp_69 <- tibble::tibble(
  grupo = c("Estrato 1 (m69)", "Estrato 6 (m69)"),
  n = c(n1_69, n6_69),
  media = c(mean(e1_69), mean(e6_69)),
  sd = c(sd(e1_69), sd(e6_69))
)

kable(disp_69, digits= 4,
      caption = "Disponibilidad en la muestra de 69 — tiempo_lectura por estrato")

Disponibilidad en la muestra de 69 — tiempo_lectura por estrato

grupo	n	media	sd
Estrato 1 (m69)	18	0.8722	0.8703
Estrato 6 (m69)	3	2.1000	0.6000

p8_muestra_posible <- (n1_69 >= 2) & (n6_69 >= 2)

# Funciones auxiliares
hedges_g <- function(x, y){
  n1 <- length(x); n2 <- length(y)
  s1 <- var(x); s2 <- var(y)
  sp <- sqrt(((n1-1)*s1 + (n2-1)*s2)/(n1+n2-2))
  d  <- (mean(x) - mean(y))/sp
  J  <- 1 - (3/(4*(n1+n2)-9))
  d * J
}

boot_diff_mean <- function(x, y, R = 20000, seed = 5633766){
  set.seed(seed)
  n1 <- length(x); n2 <- length(y)
  diffs <- replicate(R, {
    mean(sample(x, n1, replace = TRUE)) - mean(sample(y, n2, replace = TRUE))
  })
  quantile(diffs, c(0.025, 0.975), na.rm = TRUE)
}

# --- 1a) Si hay datos en ambos estratos dentro de m69, hacemos las pruebas ---
if (p8_muestra_posible) {
  # Welch (E1 - E6)
  t_w_69 <- t.test(e1_69, e6_69, var.equal = FALSE, conf.level = 0.95)
  diff69 <- unname(t_w_69$estimate[1] - t_w_69$estimate[2])  # redundante: ya lo da conf.int
  ic95_69 <- unname(t_w_69$conf.int)
  p_w_69  <- t_w_69$p.value
  df_w_69 <- unname(t_w_69$parameter)

  # Mann–Whitney
  mw_69 <- suppressWarnings(wilcox.test(e1_69, e6_69, alternative = "two.sided", exact = FALSE))
  p_mw_69 <- mw_69$p.value

  # Tamaños de efecto
  g_69 <- hedges_g(e1_69, e6_69)                     # E1 - E6
  cd_69 <- cliff.delta(e1_69, e6_69)
  cd_est_69 <- unname(cd_69$estimate); cd_mag_69 <- as.character(cd_69$magnitude)

  # Bootstrap para Δ = mean(E1) - mean(E6)
  ci_boot_69 <- boot_diff_mean(e1_69, e6_69)

  res_p8_69 <- tibble::tibble(
    n_E1 = n1_69, n_E6 = n6_69,
    media_E1 = mean(e1_69), media_E6 = mean(e6_69),
    diff_E1_menos_E6 = diff69,
    t_Welch = unname(t_w_69$statistic),
    df_Welch = df_w_69,
    p_Welch = p_w_69,
    IC95_diff_inf = ic95_69[1], IC95_diff_sup = ic95_69[2],
    p_MannWhitney = p_mw_69,
    Hedges_g = g_69,
    Cliffs_delta = cd_est_69, Cliffs_mag = cd_mag_69,
    Boot_IC95_inf = unname(ci_boot_69[1]), Boot_IC95_sup = unname(ci_boot_69[2])
  ) %>%
    dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 6)))

  # --- Tablas divididas para impresión (sin alterar res_p8_69) ---

# A) Tamaños, medias y diferencia con IC 95% + bootstrap
res_p8_69_A <- res_p8_69 |>
  dplyr::select(
    n_E1, n_E6,
    media_E1, media_E6,
    diff_E1_menos_E6,
    IC95_diff_inf, IC95_diff_sup,
    Boot_IC95_inf, Boot_IC95_sup
  )

# B) Pruebas e indicadores de efecto
res_p8_69_B <- res_p8_69 |>
  dplyr::select(
    t_Welch, df_Welch, p_Welch,
    p_MannWhitney,
    Hedges_g,
    Cliffs_delta, Cliffs_mag
  )

knitr::kable(
  res_p8_69_A,
  caption = "Punto 8 — (muestra 69) Tamaños, medias, diferencia e IC 95% (paramétrico y bootstrap)",
  digits = 6
)

knitr::kable(
  res_p8_69_B,
  caption = "Punto 8 — (muestra 69) Pruebas (Welch, Mann–Whitney) y tamaños de efecto",
  digits = 6
)
}

Punto 8 — (muestra 69) Pruebas (Welch, Mann–Whitney) y tamaños de efecto

t_Welch	df_Welch	p_Welch	p_MannWhitney	Hedges_g	Cliffs_delta	Cliffs_mag
-3.049697	3.59652	0.043735	0.038984	-1.393351	-0.777778	large

# --- 2) Pruebas con la base completa (recomendado) --------------------------
e1_full <- df %>% filter(estrato == 1) %>% pull(tiempo_lectura) %>% as.numeric()
e6_full <- df %>% filter(estrato == 6) %>% pull(tiempo_lectura) %>% as.numeric()

n1f <- length(e1_full); n6f <- length(e6_full)

# Welch (E1 - E6)
t_w_f <- t.test(e1_full, e6_full, var.equal = FALSE, conf.level = 0.95)
diff_f <- unname(t_w_f$estimate[1] - t_w_f$estimate[2])
ic95_f <- unname(t_w_f$conf.int)
p_w_f  <- t_w_f$p.value
df_w_f <- unname(t_w_f$parameter)

# Mann–Whitney
mw_f <- suppressWarnings(wilcox.test(e1_full, e6_full, alternative = "two.sided", exact = FALSE))
p_mw_f <- mw_f$p.value

# Tamaños de efecto
g_f <- hedges_g(e1_full, e6_full)
cd_f <- cliff.delta(e1_full, e6_full)
cd_est_f <- unname(cd_f$estimate); cd_mag_f <- as.character(cd_f$magnitude)

# Bootstrap para Δ
ci_boot_f <- boot_diff_mean(e1_full, e6_full)

res_p8_full <- tibble::tibble(
  n_E1 = n1f, n_E6 = n6f,
  media_E1 = mean(e1_full), media_E6 = mean(e6_full),
  diff_E1_menos_E6 = diff_f,
  t_Welch = unname(t_w_f$statistic),
  df_Welch = df_w_f,
  p_Welch = p_w_f,
  IC95_diff_inf = ic95_f[1], IC95_diff_sup = ic95_f[2],
  p_MannWhitney = p_mw_f,
  Hedges_g = g_f,
  Cliffs_delta = cd_est_f, Cliffs_mag = cd_mag_f,
  Boot_IC95_inf = unname(ci_boot_f[1]), Boot_IC95_sup = unname(ci_boot_f[2])
) %>%
  dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 6)))

# ---- Tablas divididas para impresión (sin alterar res_p8_full) ----

# A) Tamaños, medias, diferencia e IC (paramétrico y bootstrap)
res_p8_full_A <- res_p8_full |>
  dplyr::select(
    n_E1, n_E6,
    media_E1, media_E6,
    diff_E1_menos_E6,
    IC95_diff_inf, IC95_diff_sup,
    Boot_IC95_inf, Boot_IC95_sup
  )

# B) Pruebas e índices de efecto
res_p8_full_B <- res_p8_full |>
  dplyr::select(
    t_Welch, df_Welch, p_Welch,
    p_MannWhitney,
    Hedges_g,
    Cliffs_delta, Cliffs_mag
  )

knitr::kable(
  res_p8_full_A,
  caption = "Punto 8 — (base completa) Tamaños, medias, diferencia e IC 95% (paramétrico y bootstrap)",
  digits = 6
)

Punto 8 — (base completa) Tamaños, medias, diferencia e IC 95% (paramétrico y bootstrap)

n_E1	n_E6	media_E1	media_E6	diff_E1_menos_E6	IC95_diff_inf	IC95_diff_sup	Boot_IC95_inf	Boot_IC95_sup
92	7	0.744565	1.785714	-1.041149	-1.933565	-0.148733	-1.660714	-0.316304

knitr::kable(
  res_p8_full_B,
  caption = "Punto 8 — (base completa) Pruebas (Welch, Mann–Whitney) y tamaños de efecto",
  digits = 6
)

Punto 8 — (base completa) Pruebas (Welch, Mann–Whitney) y tamaños de efecto

t_Welch	df_Welch	p_Welch	p_MannWhitney	Hedges_g	Cliffs_delta	Cliffs_mag
-2.800265	6.521771	0.028528	0.007277	-1.398969	-0.607143	large

# --- Gráficas con base completa (formas más estables) -----------------------
df_plot <- tibble::tibble(
  estrato = factor(c(rep(1, n1f), rep(6, n6f))),
  lectura = c(e1_full, e6_full)
)

ggplot(df_plot, aes(x = estrato, y = lectura)) +
  geom_boxplot(outlier.alpha = 0.7,color = "navy", fill = "blue", alpha = 0.35) +
  stat_summary(fun = mean, geom = "point", shape = 24, size = 2.8, color = "navy", fill = "blue") +
  labs(title = "Tiempo de lectura — Estratos 1 vs 6 (base completa)",
       x = "Estrato", y = "Horas por día") +
  theme_minimal()

ggplot(df_plot, aes(x = lectura, fill = estrato)) +
  geom_density(alpha = 0.35, color="navy") +
  scale_fill_manual(values = c("1" = "gold", "6" = "blue")) +
  labs(title = "Densidades de tiempo de lectura — Estratos 1 vs 6",
       x = "Horas por día", y = "Densidad") +
  theme_minimal()

Interpretación

• Disponibilidad en la muestra de 69. Estrato 1: 18 casos, media 0.872 h/día;
  Estrato 6: 3 casos, media 2.1 h/día.
  La diferencia \(\mu_{E1}-\mu_{E6}\) es -1.228 h.

• Muestra de 69 — Welch. \(t = -3.05\), df ≈ 3.597, p = 0.04374.
  IC 95%: [-2.397, -0.059] h.
  Mann–Whitney: p = 0.03898.
  Tamaño de efecto: Hedges g = -1.393, Cliff’s δ = -0.778 (large).
  Bootstrap Δ: [-1.894, -0.533].
  > Aunque la evidencia apunta a que E6 lee más que E1, el n muy pequeño en E6 (3) hace que los grados de libertad sean bajos y el intervalo relativamente ancho. Se recomienda validar con la base completa.

• Base completa — Welch. Estrato 1: 92 casos, media 0.745 h;
  Estrato 6: 7 casos, media 1.786 h.
  Diferencia \(\mu_{E1}-\mu_{E6}\) = -1.041 h.
  \(t = -2.8\), df ≈ 6.522, p = 0.028528;
  IC 95%: [-1.934, -0.149] h.
  Mann–Whitney: p = 0.007277.
  Tamaño de efecto: Hedges g = -1.399 (magnitud grande),
  Cliff’s δ = -0.607 (large).
  Bootstrap Δ: [-1.661, -0.316].
  Todos los métodos coinciden en el sentido (E6 > E1) y en la relevancia práctica de la diferencia.

Conclusión. Hay evidencia estadística de que el estrato 6 dedica más tiempo a la lectura que el estrato 1. En la muestra de 69 ya se observa una diferencia importante, pero debido al n muy reducido en E6, la inferencia más confiable proviene de la base completa, donde el efecto es grande y los intervalos de confianza no incluyen 0. Aun así, se recomienda interpretar con prudencia el resultado por el tamaño pequeño del estrato 6 y considerarlo una señal robusta que justificaría recolecciones adicionales o modelos que controlen por edad y género para confirmar la asociación.

Conclusión general

El análisis permitió describir el uso del tiempo y contrastar diferencias entre grupos con resultados claros:

• Tiempo en internet. La distribución es regular y cercana a Normal:
  media 2.83 h/día, mediana 2.9 h, sd 0.81 h,
  con la mitad central entre 2.3 y 3.4 h. Shapiro–Wilk p = 0.0138 no rechaza normalidad. Hay muy pocos atípicos por encima de 5.05 h.

• Media de lectura (muestra 69). La media es 1.042 h/día.
  IC 95% (t): [0.861, 1.223];
  IC 95% bootstrap: [0.873, 1.226].
  La concordancia entre ambos respalda una estimación robusta pese a cierta no normalidad (Shapiro p = 0.0138).

• Aire libre: hombres vs. mujeres. Diferencia media (M − F) = 0.18 h`.
  Welch: p = 0.318; IC 99%: [-0.29, 0.65].
  Mann–Whitney: p = 0.253.
  Hedges g = 0.24 → efecto pequeño.
  Conclusión: no hay evidencia de diferencia relevante.

• Variabilidad en tiempo de celular. Razón de varianzas \(R=\sigma_M^2/\sigma_F^2\) = 0.94.
  F-test: p = 0.8805; Levene (mediana): p = 0.9766;
  IC 95% F: [0.477, 1.946];
  Bootstrap: [0.412, 1.928].
  Conclusión: no se evidencia diferencia en la dispersión entre géneros.

• > 3 horas/día en internet (muestra 81, α = 0.01).
  \(\hat p_H = 0.4444\), \(\hat p_M = 0.4167\); diferencia 0.0278.
  z: p = 0.802; Fisher: p = 0.8252 → no se rechaza \(H_0\) al 1%.
  OR = 1.12, IC 99% = [0.35, 3.59] (incluye 1).
  La potencia calculada con el efecto observado es muy baja, por lo que no encontrar significancia al 1% es esperable.

• IC 95% de la diferencia de proporciones (Newcombe).
  [, -0.268608] → incluye 0, consistente con el punto 6.

• Lectura: estrato 1 vs. 6. En la muestra de 69 la evidencia ya sugiere una brecha, pero el n del estrato 6 es muy pequeño.
  Con la base completa: diferencia E1 − E6 = -1.041 h;
  Welch: p = 0.028528, IC 95%: [-1.934, -0.149];
  Mann–Whitney: p = 0.007277;
  Hedges g = -1.4 (efecto grande).
  Conclusión: el estrato 6 lee más que el estrato 1, con diferencia amplia y consistente.

Balance final.
Los resultados muestran un patrón de uso de internet estable alrededor de 3 h/día, sin diferencias de género en aire libre ni en la variabilidad del uso de celular. En el uso intensivo de internet (>3 h), las proporciones entre géneros no difieren al 1%, y el intervalo al 95% para la diferencia incluye 0; la evidencia apunta a un efecto pequeño con potencia insuficiente para detectarlo bajo un umbral tan estricto. En contraste, la lectura sí presenta una brecha marcada por estrato: el estrato 6 dedica considerablemente más tiempo que el estrato 1, hallazgo robusto a varios métodos.

Recomendaciones.
1. Aumentar tamaño muestral si se desea decidir con \(\alpha=0.01\) sobre diferencias pequeñas en proporciones.
2. Explorar modelos con controles (edad, género, estrato) para lectura y uso intensivo de internet.
3. Mantener el reporte con intervalos de confianza y tamaños de efecto; aportan más información que la significancia aislada.
4. Documentar siempre las semillas y los ID muestreados (hecho en este trabajo), para garantizar reproducibilidad y auditoría.