El Teorema del Límite Central es uno de los más importantes en la inferencia estadística y habla sobre la convergencia de los estimadores como la proporción muestral a la distribución normal. Algunos autores afirman que esta aproximación es bastante buena a partir del umbral n>30
A continuación se describen los siguientes pasos para su verificación:
# a. población con 1000 individuos, de los cuales el 50% está enfermo
# Generar la población
n_poblacion <- 1000
p_enfermos <- 0.5
poblacion <- rbinom(n_poblacion, size = 1, prob = p_enfermos)
# Mostrar primeros 10 valores de la población
head(poblacion, 10)
## [1] 0 1 0 1 1 0 1 1 1 0
# b. Función para obtener una muestra aleatoria y calcular el estimador de la proporción muestral
# Función para obtener una muestra y calcular la proporción muestral
calcular_proporcion_muestral <- function(poblacion, tamano_muestra) {
muestra <- sample(poblacion, size = tamano_muestra, replace = TRUE)
prop_enfermos <- mean(muestra)
return(prop_enfermos)
}
# Proporción para una muestra de tamaño 50
calcular_proporcion_muestral(poblacion, 50)
## [1] 0.5
# c. Repetir la simulación 500 veces para un tamaño de muestra n = 30
# Repetir simulación 500 veces
n_muestras <- 500
tamano_muestra <- 30
proporciones_muestrales <- replicate(n_muestras, calcular_proporcion_muestral(poblacion, tamano_muestra))
# Graficar los resultados
qplot(proporciones_muestrales, bins = 30, main = "Distribución de la proporción muestral", xlab = "Proporción Muestral") +
geom_density(color = "red")
## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Se observa que cuando se repite la simulación 500 veces se puede
observar como la media se aproxima a una distribución normal como dice
el teorema central del limite.
# d. Repetir para diferentes tamaños de muestra y comparar la normalidad
# Prueba de normalidad para diferentes tamaños de muestra
tamanos_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)
resultados <- data.frame()
for (n in tamanos_muestra) {
proporciones_muestrales <- replicate(n_muestras, calcular_proporcion_muestral(poblacion, n))
# Shapiro-Wilk test para normalidad
shapiro_test <- shapiro.test(proporciones_muestrales)$p.value
# Guardar resultados
resultados <- rbind(resultados, data.frame(TamanoMuestra = n, PValor = shapiro_test))
# Gráfico QQ
qqnorm(proporciones_muestrales, main = paste("Gráfico QQ para n =", n))
qqline(proporciones_muestrales)
}
# Mostrar resultados de Shapiro-Wilk
resultados
## TamanoMuestra PValor
## 1 5 1.871877e-14
## 2 10 7.298832e-10
## 3 15 2.886015e-07
## 4 20 6.275738e-07
## 5 30 1.677855e-04
## 6 50 7.190228e-04
## 7 60 1.896233e-03
## 8 100 2.101609e-02
## 9 200 1.254082e-01
## 10 500 4.700349e-01
De acuerdo con la prueba de Shapiro-Wilk, para muestras de tamaño 200 y 500, no rechazamos la hipótesis nula con un nivel de significancia de 0.05, ya que el valor p es mayor a 0.05. Esto indica que no hay suficiente evidencia para sugerir que la distribución de la muestra difiere de una distribución normal, lo que significa que los datos observados son consistentes con el supuesto de normalidad.
# e. Repetir la simulación con el 10% y el 90% de enfermos
# Población con el 10% enfermo
poblacion_10 <- rbinom(n_poblacion, size = 1, prob = 0.1)
# Población con el 90% enfermo
poblacion_90 <- rbinom(n_poblacion, size = 1, prob = 0.9)
# Simulación para el 10% de enfermos
proporciones_muestrales_10 <- replicate(n_muestras, calcular_proporcion_muestral(poblacion_10, tamano_muestra))
qplot(proporciones_muestrales_10, bins = 30, main = "Distribución con 10% de enfermos", xlab = "Proporción Muestral")
# Simulación para el 90% de enfermos
proporciones_muestrales_90 <- replicate(n_muestras, calcular_proporcion_muestral(poblacion_90, tamano_muestra))
qplot(proporciones_muestrales_90, bins = 30, main = "Distribución con 90% de enfermos", xlab = "Proporción Muestral")
tamanos_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)
resultados <- data.frame()
for (n in tamanos_muestra) {
proporciones_muestrales <- replicate(n_muestras, calcular_proporcion_muestral(poblacion_10, n))
# Shapiro-Wilk test para normalidad
shapiro_test <- shapiro.test(proporciones_muestrales)$p.value
# Guardar resultados
resultados <- rbind(resultados, data.frame(TamanoMuestra = n, PValor = shapiro_test))
# Gráfico QQ
qqnorm(proporciones_muestrales, main = paste("Gráfico QQ para n =", n))
qqline(proporciones_muestrales)
}
# Mostrar resultados de Shapiro-Wilk
resultados
## TamanoMuestra PValor
## 1 5 3.562849e-29
## 2 10 6.635692e-22
## 3 15 9.522470e-18
## 4 20 1.067005e-14
## 5 30 6.821174e-12
## 6 50 1.461455e-07
## 7 60 2.117329e-08
## 8 100 1.168321e-05
## 9 200 3.626869e-03
## 10 500 1.522289e-01
tamanos_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)
resultados <- data.frame()
for (n in tamanos_muestra) {
proporciones_muestrales <- replicate(n_muestras, calcular_proporcion_muestral(poblacion_90, n))
# Shapiro-Wilk test para normalidad
shapiro_test <- shapiro.test(proporciones_muestrales)$p.value
# Guardar resultados
resultados <- rbind(resultados, data.frame(TamanoMuestra = n, PValor = shapiro_test))
# Gráfico QQ
qqnorm(proporciones_muestrales, main = paste("Gráfico QQ para n =", n))
qqline(proporciones_muestrales)
}
# Mostrar resultados de Shapiro-Wilk
resultados
## TamanoMuestra PValor
## 1 5 9.918905e-31
## 2 10 6.571443e-24
## 3 15 4.985255e-21
## 4 20 7.382404e-17
## 5 30 5.869806e-14
## 6 50 2.039079e-09
## 7 60 3.845998e-09
## 8 100 6.344335e-06
## 9 200 1.207514e-03
## 10 500 1.249158e-01
Basado en los resultados obtenidos, se puede observar como cambia la simetría, el sesgo y la variabilidad de las proporciones muestrales a medida que varia el tamaño de la muestra y la proporción de plantas enfermas en la población.
Entre más alejado este el porcentaje de plantas enfermas a 50% (como es el caso del 90% y el 10%) se necesitará una muestra más grande para evitar sesgos y tener una muestra que en verdad represente a la población.