library(dplyr)
library(ggplot2)
library(openxlsx)
library(DT)
library(knitr)
library(moments)
library(nortest)
datos <- read.xlsx("base_encuesta_habitos.xlsx")
DT::datatable(
head(datos),
options = list(
pageLength = 6,
dom = 't',
ordering = FALSE
),
caption = 'Tabla de Datos'
)
Realice un análisis descriptivo numérico completo para la variable tiempo en internet que incluya las medidas de tendencia central, de variabilidad, de posición y de forma.
media <- mean(datos$tiempo_internet, na.rm = TRUE)
mediana <- median(datos$tiempo_internet, na.rm = TRUE)
moda <- datos$tiempo_internet %>%
table() %>%
sort(decreasing = TRUE) %>%
head(1)
print(paste(" - Media: ", round(media, 2)))
## [1] " - Media: 2.83"
print(paste(" - Mediana: ", mediana))
## [1] " - Mediana: 2.9"
print(paste(" - Moda: ", moda))
## [1] " - Moda: 22"
ggplot(datos, aes(x = tiempo_internet)) +
geom_histogram(bins = 20, fill = "lightblue", color = "black") +
labs(title = "Histograma del tiempo en internet",
x = "Horas al dia",
y = "Frecuencia")
El histograma muestra una distribución unimodal, con la mayor concentración de observaciones entre 2 y 4 horas diarias. Evidenciamos que, un grupo reducido de personas presenta un tiempo de uso de internet mayores.
varianza <- var(datos$tiempo_internet, na.rm = TRUE)
desviacion <- sd(datos$tiempo_internet, na.rm = TRUE)
rango <- range(datos$tiempo_internet, na.rm = TRUE)
IQR_val <- IQR(datos$tiempo_internet, na.rm = TRUE)
print(paste(" - varianza: ",varianza))
## [1] " - varianza: 0.650922656960873"
print(paste(" - desviacion: ", desviacion))
## [1] " - desviacion: 0.806797779471953"
print(paste(" - rango (Min/Max): ", rango[1], " - ", rango[2]))
## [1] " - rango (Min/Max): 0.7 - 5.2"
print(paste(" - Rango Intercuartílico: ",IQR_val))
## [1] " - Rango Intercuartílico: 1.1"
cuartiles <- quantile(datos$tiempo_internet, probs = c(0.25, 0.5, 0.75), na.rm = TRUE)
percentiles <- quantile(datos$tiempo_internet, probs = seq(0,1,0.1), na.rm = TRUE)
cuartiles_df <- data.frame(
Cuartil = names(cuartiles),
Valor = as.numeric(cuartiles)
)
percentiles_df <- data.frame(t(percentiles))
print("### Cuartiles")
## [1] "### Cuartiles"
kable(cuartiles_df, caption = "Cuartiles del tiempo de Internet")
| Cuartil | Valor |
|---|---|
| 25% | 2.3 |
| 50% | 2.9 |
| 75% | 3.4 |
print("### Percentiles")
## [1] "### Percentiles"
kable(percentiles_df, caption = "Percentiles del tiempo de Internet")
| X0. | X10. | X20. | X30. | X40. | X50. | X60. | X70. | X80. | X90. | X100. |
|---|---|---|---|---|---|---|---|---|---|---|
| 0.7 | 1.74 | 2.1 | 2.5 | 2.7 | 2.9 | 3.1 | 3.3 | 3.5 | 3.86 | 5.2 |
# Boxplot
ggplot(datos, aes(y = tiempo_internet)) +
geom_boxplot(fill = "orange") +
labs(title = "Boxplot del tiempo en internet",
y = "Horas al dia")
El boxplot evidencia que la mediana del tiempo diario de uso de internet se sitúa aproximadamente en 3 horas, con un rango intercuartílico que concentra el 50 % central de los datos entre valores cercanos a 2.3 y 3.5 horas.
asimetria <- skewness(datos$tiempo_internet, na.rm = TRUE)
curtosis <- kurtosis(datos$tiempo_internet, na.rm = TRUE)
estadisticos_descriptivos <- data.frame(
Medida = c("Asimetria ", "Curtosis "),
Valor = c(asimetria, curtosis)
)
kable(
estadisticos_descriptivos,
caption = "Forma de la Distribucion",
col.names = c("Tipo", "Valor Calculado"),
digits = 4
)
| Tipo | Valor Calculado |
|---|---|
| Asimetria | -0.1511 |
| Curtosis | 2.7564 |
ggplot(datos, aes(x = tiempo_internet)) +
geom_density(fill = "lightgreen", alpha = 0.6) +
labs(title = "Curva de densidad del tiempo en internet",
x = "Horas al dia",
y = "Densidad")
La curva de densidad muestra una distribución unimodal y ligeramente sesgada a la derecha. El pico principal se localiza alrededor de las 3 horas diarias, lo que coincide con la media y la mediana obtenidas en el análisis numérico. La forma de la curva sugiere una concentración moderada de los datos alrededor del valor central y una cierta dispersión hacia valores mayores.
Tome una muestra aleatoria de 69 datos utilizando como semilla los últimos dígitos del documento de identidad de cada integrante del grupo y, con base en esa muestra, realice los siguientes ejercicios.
set.seed(51617117)
muestra <- datos %>%
sample_n(69)
nrow(muestra)
## [1] 69
# Variable de interés
x_lectura <- muestra$tiempo_lectura
# Resumen numérico base
n_lectura <- length(x_lectura)
xbar_lectura <- mean(x_lectura, na.rm = TRUE)
s_lectura <- sd(x_lectura, na.rm = TRUE)
alpha <- 0.05
tcrit <- qt(1 - alpha/2, df = n_lectura - 1)
li_lectura <- xbar_lectura - tcrit * (s_lectura / sqrt(n_lectura))
ls_lectura <- xbar_lectura + tcrit * (s_lectura / sqrt(n_lectura))
ic_lectura_df <- data.frame(
n = n_lectura,
media_muestral = xbar_lectura,
sd_muestral = s_lectura,
LI_95 = li_lectura,
LS_95 = ls_lectura
)
knitr::kable(ic_lectura_df, digits = 4,
caption = "IC 95% para la media del tiempo de lectura (horas/día)")
| n | media_muestral | sd_muestral | LI_95 | LS_95 |
|---|---|---|---|---|
| 69 | 1.2043 | 0.7768 | 1.0177 | 1.3909 |
# Verificación con t.test (debe coincidir con el cálculo manual)
t.test(x_lectura, conf.level = 0.95)
##
## One Sample t-test
##
## data: x_lectura
## t = 12.879, df = 68, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
## 1.017749 1.390947
## sample estimates:
## mean of x
## 1.204348
lectura_plot_df <- data.frame(tiempo_lectura = x_lectura)
ggplot(lectura_plot_df, aes(x = tiempo_lectura)) +
geom_histogram(bins = 15, fill = "lightblue", color = "black") +
geom_vline(xintercept = xbar_lectura, linewidth = 1) +
geom_vline(xintercept = c(li_lectura, ls_lectura), linetype = "dashed", linewidth = 1) +
labs(
title = "Tiempo dedicado a lectura (muestra n=69)",
subtitle = "Línea sólida: media muestral | Líneas punteadas: IC 95%",
x = "Horas/día",
y = "Frecuencia"
)
# Creamos una versión con género como factor (definimos el orden para que la diferencia sea Hombre - Mujer)
muestra2 <- muestra %>%
mutate(genero_fac = factor(genero, levels = c("M", "F"), labels = c("Hombre", "Mujer")))
# Tabla descriptiva por grupo (antes de inferir)
resumen_aire <- muestra2 %>%
group_by(genero_fac) %>%
summarise(
n = n(),
media = mean(tiempo_aire_libre, na.rm = TRUE),
sd = sd(tiempo_aire_libre, na.rm = TRUE),
.groups = "drop"
)
knitr::kable(resumen_aire, digits = 4,
caption = "Resumen por género: tiempo al aire libre (horas/día)")
| genero_fac | n | media | sd |
|---|---|---|---|
| Hombre | 28 | 1.7000 | 0.9177 |
| Mujer | 41 | 1.5244 | 0.6640 |
# Prueba t de Welch + IC 99% para la diferencia (Hombre - Mujer)
alpha <- 0.01
prueba_aire <- t.test(
tiempo_aire_libre ~ genero_fac,
data = muestra2,
alternative = "two.sided",
conf.level = 0.99
)
prueba_aire
##
## Welch Two Sample t-test
##
## data: tiempo_aire_libre by genero_fac
## t = 0.86905, df = 45.804, p-value = 0.3894
## alternative hypothesis: true difference in means between group Hombre and group Mujer is not equal to 0
## 99 percent confidence interval:
## -0.3674582 0.7186777
## sample estimates:
## mean in group Hombre mean in group Mujer
## 1.70000 1.52439
# Decisión a alpha = 0.01
decision <- ifelse(prueba_aire$p.value < alpha, "Rechazo H0", "No rechazo H0")
decision
## [1] "No rechazo H0"
ggplot(muestra2, aes(x = genero_fac, y = tiempo_aire_libre)) +
geom_boxplot(fill = "orange") +
geom_jitter(width = 0.15, alpha = 0.6) +
labs(
title = "Tiempo al aire libre por género (muestra n=69)",
x = "Género",
y = "Horas/día"
)
dif_media <- unname(prueba_aire$estimate["mean in group Hombre"] - prueba_aire$estimate["mean in group Mujer"])
li <- prueba_aire$conf.int[1]
ls <- prueba_aire$conf.int[2]
dif_df <- data.frame(
comparacion = "Hombre - Mujer",
diferencia = dif_media,
LI_99 = li,
LS_99 = ls
)
ggplot(dif_df, aes(x = comparacion, y = diferencia)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = LI_99, ymax = LS_99), width = 0.15, linewidth = 1) +
geom_hline(yintercept = 0, linetype = "dashed") +
labs(
title = "IC 99% para la diferencia de medias (tiempo al aire libre)",
subtitle = "Si el 0 NO está dentro del intervalo, hay evidencia de diferencia (α = 0.01).",
x = "",
y = "Diferencia de medias (horas/día)"
)
# Resumen de varianzas por grupo
resumen_cel <- muestra2 %>%
group_by(genero_fac) %>%
summarise(
n = n(),
varianza = var(tiempo_celular, na.rm = TRUE),
sd = sd(tiempo_celular, na.rm = TRUE),
.groups = "drop"
)
knitr::kable(resumen_cel, digits = 4,
caption = "Variabilidad por género: tiempo en celular (horas/día)")
| genero_fac | n | varianza | sd |
|---|---|---|---|
| Hombre | 28 | 1.1239 | 1.0601 |
| Mujer | 41 | 0.6269 | 0.7918 |
# Prueba F (var.test): compara varianzas
prueba_var <- var.test(tiempo_celular ~ genero_fac, data = muestra2, alternative = "two.sided")
prueba_var
##
## F test to compare two variances
##
## data: tiempo_celular by genero_fac
## F = 1.7928, num df = 27, denom df = 40, p-value = 0.09152
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
## 0.9092348 3.7099061
## sample estimates:
## ratio of variances
## 1.792793
# Interpretación rápida (alpha típico = 0.05 si no se especifica otro)
alpha <- 0.05
decision_var <- ifelse(prueba_var$p.value < alpha, "Rechazo H0: varianzas distintas", "No rechazo H0: no evidencia de diferencia")
decision_var
## [1] "No rechazo H0: no evidencia de diferencia"
ggplot(muestra2, aes(x = genero_fac, y = tiempo_celular)) +
geom_boxplot(fill = "lightgreen") +
geom_jitter(width = 0.15, alpha = 0.6) +
labs(
title = "Tiempo dedicado al celular por género (muestra n=69)",
x = "Género",
y = "Horas/día"
)
ggplot(muestra2, aes(sample = tiempo_celular)) +
stat_qq() +
stat_qq_line() +
facet_wrap(~ genero_fac) +
labs(
title = "QQ-plot del tiempo en celular por género",
subtitle = "La prueba F asume (aprox.) normalidad dentro de cada grupo."
)
cambie el tamaño de la muestra a 81 y defina una variable binaria que sea 1 si una persona dedica más de 3 horas al día a internet, y 0 en caso contrario. ¿La proporción de personas que dedican más de 3 horas al día a internet es la misma en hombres y mujeres? Use un alfa de 0.01.
# sacamos la muestra de 81 datos y verificamos que sea el numero correcto
muestra2 <- datos %>%
sample_n(81)
nrow(muestra2)
## [1] 81
ya creada la muestra, creamos la nueva variable binaria que exprese si una persona ah estado mas de 3 horas conectada al internet o lo contrario por medio de un uno o un cero respectivamente.
muestra3 <- muestra2 %>%
mutate(
internet_3h = ifelse(tiempo_internet > 3, 1, 0)
)
table(muestra3$internet_3h) ## muestra cuantas variables 1 y 0 hay en total.
##
## 0 1
## 50 31
tabla5 <- table(muestra3$genero, muestra3$internet_3h) ##ya muestra de manera ordenada y por genero el numero de personas que consumen mas de una a tres horas internet
df_tabla5 <- as.data.frame(tabla5)
colnames(df_tabla5) <- c("Genero", "Internet_3h", "Frecuencia")
df_tabla5$Internet_3h <- factor(
df_tabla5$Internet_3h,
levels = c(0, 1),
labels = c("≤ 3 horas", "> 3 horas")
)
ggplot(df_tabla5, aes(x = Genero, y = Frecuencia, fill = Internet_3h)) +
geom_bar(stat = "identity", position = "fill") +
geom_text(
aes(label = scales::percent(Frecuencia / sum(Frecuencia))),
position = position_fill(vjust = 0.5),
size = 4
) +
scale_y_continuous(labels = scales::percent) +
labs(
title = "Uso de internet mayor a 3 horas diarias por género",
x = "Género",
y = "Proporción",
fill = "Tiempo en internet"
) +
theme_minimal(base_size = 13)
Cada barra muestra el 100% las personas que usan internet dentro de la muestra divididos por genero, ademas se comprara directamente el porcentaje de personas que se conectan mas de 3 horas a internet y las que no.
Para realizar una prueba de hipotesis periemro verificamos que la muesta de tiempo_internet sea normal y asi poder prosegir con las pruebas; esto por medio de una prueba del paquete nortest llamada lillie.test.
lill_test <- lillie.test(muestra$tiempo_internet)
lill_test
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: muestra$tiempo_internet
## D = 0.071769, p-value = 0.5095
como el p-value es mayor a 0.05 podemos proseguir ya que indica que los datos muestran una tendencia normal y esta se mantendrá en todas las muestras.
nuestra hipótesis nula o cero sera:
H₀:proporción hombres= proporción mujeres.
así mismo nuestra hipótesis sera:
H₁:proporción hombres ≠ proporción mujeres.
para comparar esto realizaremos una prueba de igualdad de proporciones.
Se calcula el estadístico de prueba y r nos devuelve el p-value el cual si es < 0.01 podemos concluir que sí hay diferencia estadísticamente significativa y las proporciones no son iguales entre hombres y mujeres.
si el p-value es ≥ 0.01 No rechazamos H₀ es decir no podemos afirmar que exista diferencia aunque no significa que sean iguales, sino que no hay evidencia suficiente para negarlo.
Tambien se construye un intervalo de confianza del 99% (coherente con \(\alpha = 0.01\)) y Si el intervalo de confianza no contiene 0 → coincide con rechazar H₀
exitos <- tabla5[, "1"]
n <- rowSums(tabla5)
prop.test(
x = exitos,
n = n,
alternative = "two.sided",
conf.level = 0.99
)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: exitos out of n
## X-squared = 0.13671, df = 1, p-value = 0.7116
## alternative hypothesis: two.sided
## 99 percent confidence interval:
## -0.2375738 0.3668421
## sample estimates:
## prop 1 prop 2
## 0.4146341 0.3500000
Proporciones muestrales - prop 1 = 0.4878 - prop 2 = 0.4286 Esto significa que el 48.78 % de un género (por ejemplo hombres) 42.86 % del otro género (por ejemplo mujeres) usan más de 3 horas diarias de Internet.
p-value = 0.8114, debido a que 0.8114 > 0.01 No rechazamos la hipótesis nula ya que la diferencia observada es totalmente compatible con el azar y no hay evidencia estadística de que las proporciones sean distintas
tambien se puede agregar de mas que como el intervalo de confianza del 99% es = -0.2846082 , 0.4030751 se puede tambien concluir que como incluye al 0, no hay una diferencia significativa ya que podría ser de 28 % menos en hombres o hasta 40 % más en hombres es decir que El intervalo es muy amplio y esto deja pensar que existe una Alta incertidumbre en la muestra.
Con un nivel de significancia de \(\alpha = 0.01\), no se encontró evidencia estadísticamente significativa para poder afirmar que la proporción de personas que dedican más de 3 horas diarias a internet difiera entre hombres y mujeres (p = 0.8114).
resumen5 <- data.frame(
Genero = c("Hombres", "Mujeres"),
Proporcion_3h = c(0.4878, 0.4286)
)
resumen5
## Genero Proporcion_3h
## 1 Hombres 0.4878
## 2 Mujeres 0.4286
Aunque en el punto anterior realizamos un intervalo de confianza del 99 debido a que la funcion lo permitia ahora lo realizaremos con un porcentaje de 95 asi tener mas informacion acerca de las proporciones de las personas que estan por mas de tres horas en el internet.
prop.test(
x = exitos,
n = n,
alternative = "two.sided",
conf.level = 0.95
)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: exitos out of n
## X-squared = 0.13671, df = 1, p-value = 0.7116
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.1712222 0.3004905
## sample estimates:
## prop 1 prop 2
## 0.4146341 0.3500000
Podemos decir con un 95 % de confianza que la diferencia entre la proporción de hombres y mujeres que dedican más de 3 horas diarias a Internet se encuentra entre el −20.96 % y 32.81 %.
Este intervalo contiene al 0 Eso significa que es posible una diferencia nula donde \(ph-pm=0\) se puede decir también que no hay evidencia estadística de una diferencia real entre hombres y mujeres por ende no se rechaza la hipótesis nula en el que contraste la igualdad de proporciones entre los géneros.
Este resultado es consistente con el contraste de hipótesis realizado en el punto anterior, en el cual no se rechazó la hipótesis nula de igualdad de proporciones debido a un p-value de 0.8114 que indicaba la misma conclusión de este punto.
# Filtrar estratos 1 y 6
datos_estratos <- datos %>%
filter(estrato %in% c(1, 6))
# Resumen descriptivo
datos_estratos %>%
group_by(estrato) %>%
summarise(
n = n(),
media = mean(tiempo_lectura, na.rm = TRUE),
sd = sd(tiempo_lectura, na.rm = TRUE)
)
## # A tibble: 2 × 4
## estrato n media sd
## <dbl> <int> <dbl> <dbl>
## 1 1 92 0.745 0.721
## 2 6 7 1.79 0.963
shapiro.test(datos_estratos$tiempo_lectura[datos_estratos$estrato == 1])
##
## Shapiro-Wilk normality test
##
## data: datos_estratos$tiempo_lectura[datos_estratos$estrato == 1]
## W = 0.88908, p-value = 1.084e-06
shapiro.test(datos_estratos$tiempo_lectura[datos_estratos$estrato == 6])
##
## Shapiro-Wilk normality test
##
## data: datos_estratos$tiempo_lectura[datos_estratos$estrato == 6]
## W = 0.91203, p-value = 0.4101
t.test(
tiempo_lectura ~ estrato,
data = datos_estratos,
var.equal = FALSE
)
##
## Welch Two Sample t-test
##
## data: tiempo_lectura by estrato
## t = -2.8003, df = 6.5218, p-value = 0.02853
## alternative hypothesis: true difference in means between group 1 and group 6 is not equal to 0
## 95 percent confidence interval:
## -1.9335647 -0.1487335
## sample estimates:
## mean in group 1 mean in group 6
## 0.7445652 1.7857143
El análisis descriptivo muestra que el estrato 6 presenta un mayor tiempo promedio dedicado a la lectura en comparación con el estrato 1. No obstante, el tamaño muestral del estrato 6 es considerablemente menor, lo cual debe tenerse en cuenta en la interpretación de los resultados.
La prueba de Shapiro-Wilk indica que la variable tiempo de lectura no presenta desviaciones severas de la normalidad en ninguno de los dos estratos, por lo que es adecuado aplicar una prueba t para dos muestras independientes.