Problema 3: Teorema del Límite Central

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 𝑛>30.

A continuación se describen los pasos para su verificación:

Solución

Se realiza una simulación en la cual se genera una población de 𝑛=1000 (Lote), donde el porcentaje de individuos de plantas enfermas sea del 50%. Para ello, usamos el siguiente código en R que genera una población binomial donde 1 representa las plantas enfermas y 0 las plantas sanas.

# Número total de individuos
n <- 1000

# Probabilidad de que un individuo esté enfermo
pe <- 0.5

# Generar la población: 1 representa enfermo, 0 representa sano
set.seed(123)  # Para reproducibilidad
poblacion <- rbinom(n, 1, pe)

cat("Este es el encabezado del vector **poblacion** resultante de una distribución binomial : ", head(poblacion), " ...")
Este es el encabezado del vector **poblacion** resultante de una distribución binomial :  0 1 0 1 1 0  ...

A continuación se genera una función que permite calcular un estimador para la proporción de plantas enfermas con un tamaño de muestra dado 𝑛:

  • Obtener una muestra aleatoria de la población
  • Calcular el estimador de la proporción muestral

Cómo resultado se puede observar el siguiente gráfico que calcula el estimador (Promedio) para 500 simulaciones para una muestra de tamaño = 100.

# Número de simulaciones y tamaño de las muestras
num_simulaciones <- 500
t_muestra <- 100

# Función para calcular la proporción muestral
proporcion <- function(poblacion, t_muestra) {
  M <- sample(poblacion, size = t_muestra, replace = FALSE)
  mean(M)
}

# Realizando las simulaciones
proporcion_M <- replicate(n = num_simulaciones, proporcion(poblacion, t_muestra))

# Visualizando los resultados
ggplot(data.frame(proporciones = proporcion_M), aes(x = proporciones)) +
  geom_histogram(binwidth = 0.02, fill = "lightblue", color = "black") +
  geom_vline(aes(xintercept = mean(proporcion_M), color = "Media de la muestra"), 
             linetype = "dashed", linewidth = 1) +  # Línea para la media
  geom_vline(aes(xintercept = 0.5, color = "Valor estimador 0.5"), 
             linetype = "dotted", linewidth = 1) +  # Línea para el valor 0.5
  labs(title = "Distribución de las proporciones muestrales",
       x = "Proporción muestral de plantas enfermas",
       y = "Frecuencia",
       color = "Líneas verticales") +  # Título de la leyenda
  scale_color_manual(values = c("Media de la muestra" = "red", "Valor estimador 0.5" = "blue"))

cat("La variabilidad para los resultados de la simulación a partir de la desviación estándar es: ", sd(proporcion_M))
La variabilidad para los resultados de la simulación a partir de la desviación estándar es:  0.04647699

El anterior gráfico nos muestra cómo se distribuyen las diferentes proporciones de plantas enfermas que encontramos en cada una de las muestras aleatorias que tomamos de nuestra población. En donde el eje “x” representa los diferentes valores posibles para la proporción de plantas enfermas en una muestra y el eje “y” la frecuencia con la que se obtuvo cada proporción en las múltiples simulaciones.

En este caso podemos ver que la distribución de la muestra en las simulaciones tiende a ser normal, lo que indica que el estimador de la proporción muestral no es sesgado y que el Teorema del Límite Central se cumple. Como se observa el estimador está muy cerca del valor del parámetro y adicionalmente, la variabilidad es baja (~0.05 ), lo que indica que el estimador es preciso” y muestra eficiencia

# Función para calcular la proporción muestral
proporcion <- function(poblacion, t_muestra) {
  muestra <- sample(poblacion, size = t_muestra, replace = FALSE)
  mean(muestra)
}

# Tamaño de la población y proporción de enfermos
set.seed(123)
N <- 1000
p <- 0.5
poblacion <- rbinom(n = N, size = 1, prob = p)

# Tamaños de muestra a evaluar
t_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)

# Lista para almacenar los resultados
resultados <- list()

# Ciclo for para iterar sobre los tamaños de muestra
for (n in t_muestra) {
  # Realizar las simulaciones
  proporcion_M <- replicate(n = 500, proporcion(poblacion, n))
  
  # Prueba de Shapiro-Wilk
  shapiro_test <- shapiro.test(proporcion_M)
  
  # Guardar resultados
  resultados[[as.character(n)]] <- list(
    proporciones = proporcion_M,
    shapiro_test = shapiro_test
  )
}

# Función para crear el mosaico de gráficos de densidad
gridExtra::grid.arrange(grobs = lapply(names(resultados), function(name) {
  x <- resultados[[name]]
  ggplot(data.frame(proporciones = x$proporciones), aes(x = proporciones)) +
    geom_density(fill = "lightblue", alpha = 0.5) +
    ggtitle(paste("Tamaño de muestra =", name))+
    theme(plot.title = element_text(size = 8))  # Ajusta el tamaño de la letra del título (puedes cambiar 10 por el tamaño deseado)
}))

# Crear un mosaico de gráficos QQ plot
gridExtra::grid.arrange(grobs = lapply(names(resultados), function(name) {
  x <- resultados[[name]]
  ggplot(data.frame(proporciones = x$proporciones), aes(sample = proporciones)) +
    stat_qq() +
    stat_qq_line(col = "red") +
    ggtitle(paste("Tamaño de muestra =", name))+
    theme(plot.title = element_text(size = 8))  # Ajusta el tamaño de la letra del título (puedes cambiar 10 por el tamaño deseado)
}))

Se hace evidente al analizar los gráficos que el teorema del límite central se cumple ya que a medida que aumenta el tamaño de la muestra el comportamiento se asemeja más a la distribución normal representada en los QQPlot por la línea recta.

Repetición con lotes con 10% de plantas enfermas
proporcion <- function(poblacion, t_muestra) {
  muestra <- sample(poblacion, size = t_muestra, replace = FALSE)
  mean(muestra)
}

# Tamaño de la población y proporción de enfermos
set.seed(123)
N <- 1000
p <- 0.1
poblacion <- rbinom(n = N, size = 1, prob = p)

# Tamaños de muestra a evaluar
t_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)

# Lista para almacenar los resultados
resultados <- list()

# Ciclo for para iterar sobre los tamaños de muestra
for (n in t_muestra) {
  # Realizar las simulaciones
  proporcion_M <- replicate(n = 500, proporcion(poblacion, n))
  
  # Prueba de Shapiro-Wilk
  shapiro_test <- shapiro.test(proporcion_M)
  
  # Guardar resultados, incluyendo el tamaño de la muestra
  resultados[[as.character(n)]] <- list(
    proporciones = proporcion_M,
    shapiro_test = shapiro_test,
    t_muestra = n  # Guardar el tamaño de la muestra
  )
}

# Función para crear el mosaico de gráficos de densidad
gridExtra::grid.arrange(grobs = lapply(resultados, function(x) {
  ggplot(data.frame(proporciones = x$proporciones), aes(x = proporciones)) +
    geom_density(fill = "lightblue", alpha = 0.5) +
    ggtitle(paste("Tamaño de muestra =", x$t_muestra))+
    theme(plot.title = element_text(size = 8))  # Ajusta el tamaño de la letra del título (puedes cambiar 10 por el tamaño deseado) 
}))

# Crear un mosaico de gráficos QQ plot
gridExtra::grid.arrange(grobs = lapply(names(resultados), function(name) {
  x <- resultados[[name]]
  ggplot(data.frame(proporciones = x$proporciones), aes(sample = proporciones)) +
    stat_qq() +
    stat_qq_line(col = "red") +
    ggtitle(paste("Tamaño de muestra =", name))+
    theme(plot.title = element_text(size = 8))  # Ajusta el tamaño de la letra del título (puedes cambiar 10 por el tamaño deseado)
}))

Test shapiro - Wilks para un 10% de las plantas enfermas.

Para contrastar la normalidad de estos conjuntos de datos se utiliza una prueba de hipótesis no paramétrica, la prueba de Shapiro-Wilks. La hipótesis nula en este problema se plantea como: Ho=“Los datos de la muestra provienen de una distribución normal” Ha= “Los datos de la muestra no provienen de una distribución normal.

shapiro_results <- data.frame(
  Tamaño_Muestra = t_muestra,
  W_Statistic = sapply(resultados, function(x) x$shapiro_test$statistic),
  P_Value = sapply(resultados, function(x) x$shapiro_test$p.value)
)

# Formatear tabla con kableExtra:

shapiro_results %>%
  kbl(caption = "Resultados del test de Shapiro-Wilk para cada tamaño de muestra") %>%
  kable_styling(full_width = F, position = "center")
Resultados del test de Shapiro-Wilk para cada tamaño de muestra
Tamaño_Muestra W_Statistic P_Value
5.W 5 0.6809526 0.0000000
10.W 10 0.8087821 0.0000000
15.W 15 0.8933416 0.0000000
20.W 20 0.9123013 0.0000000
30.W 30 0.9549978 0.0000000
50.W 50 0.9659629 0.0000000
60.W 60 0.9750763 0.0000002
100.W 100 0.9862855 0.0001187
200.W 200 0.9908410 0.0034159
500.W 500 0.9947125 0.0831357

Estos resultados de la prueba Shapiro - Wilks muestran que a partir de una muestra superior a los 500 individuos, es posible rechazar la Ha y acepta la Ho pues la muestra tienen un comportamiento normal, esto debido a que el p-value es superior al nivel de significancia (0,05). A pesar de que haciendo un anáisis visual de los gráficos de densidades pareciera que la distribución a partir del tamaño de muestra de 50 ya comienza a tener una distribución normal, la prueba indica que es solo hasta que la muestra es superior a 500 individuos de plantas que obenemos este resultado.

Repetición con lotes con 90% de plantas enfermas
# Función para calcular la proporción muestral
proporcion <- function(poblacion, t_muestra) {
  muestra <- sample(poblacion, size = t_muestra, replace = FALSE)
  mean(muestra)
}

# Tamaño de la población y proporción de enfermos
set.seed(123)
N <- 1000
p <- 0.9
poblacion <- rbinom(n = N, size = 1, prob = p)

# Tamaños de muestra a evaluar
t_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)

# Lista para almacenar los resultados
resultados <- list()

# Ciclo for para iterar sobre los tamaños de muestra
for (n in t_muestra) {
  # Realizar las simulaciones
  proporcion_M <- replicate(n = 500, proporcion(poblacion, n))
  
  # Prueba de Shapiro-Wilk
  shapiro_test <- shapiro.test(proporcion_M)
  
  # Guardar resultados
  resultados[[as.character(n)]] <- list(
    proporciones = proporcion_M,
    shapiro_test = shapiro_test,
    t_muestra = n  # Guardar el tamaño de la muestra
  )
}

# Función para crear el mosaico de gráficos de densidad
gridExtra::grid.arrange(grobs = lapply(resultados, function(x) {
  ggplot(data.frame(proporciones = x$proporciones), aes(x = proporciones)) +
    geom_density(fill = "lightblue", alpha = 0.5) +
    ggtitle(paste("Tamaño de muestra =", x$t_muestra))+
    theme(plot.title = element_text(size = 8))  # Ajusta el tamaño de la letra del título (puedes cambiar 10 por el tamaño deseado)  
}))

# Crear un mosaico de gráficos QQ plot
gridExtra::grid.arrange(grobs = lapply(names(resultados), function(name) {
  x <- resultados[[name]]
  ggplot(data.frame(proporciones = x$proporciones), aes(sample = proporciones)) +
    stat_qq() +
    stat_qq_line(col = "red") +
    ggtitle(paste("Tamaño de muestra =", name))+
    theme(plot.title = element_text(size = 8))  # Ajusta el tamaño de la letra del título (puedes cambiar 10 por el tamaño deseado)
}))

shapiro_results <- data.frame(
  Tamaño_Muestra = t_muestra,
  W_Statistic = sapply(resultados, function(x) x$shapiro_test$statistic),
  P_Value = sapply(resultados, function(x) x$shapiro_test$p.value)
)

# Formatear tabla con kableExtra:

shapiro_results %>%
  kbl(caption = "Resultados del test de Shapiro-Wilk para cada tamaño de muestra") %>%
  kable_styling(full_width = F, position = "center")
Resultados del test de Shapiro-Wilk para cada tamaño de muestra
Tamaño_Muestra W_Statistic P_Value
5.W 5 0.6809526 0.0000000
10.W 10 0.8087821 0.0000000
15.W 15 0.8933416 0.0000000
20.W 20 0.9123013 0.0000000
30.W 30 0.9549978 0.0000000
50.W 50 0.9659629 0.0000000
60.W 60 0.9750763 0.0000002
100.W 100 0.9862855 0.0001187
200.W 200 0.9908410 0.0034159
500.W 500 0.9947125 0.0831357

Estos resultados de la prueba Shapiro - Wilks muestran nuevamente que a partir de una muestra superior a los 500 individuos, es posible rechazar la Ha y acepta la Ho pues la muestra tienen un comportamiento normal. Este resultado obtenido cuando la probabilidad de que las plantas enfermas sea del 90% es igual al obtenido cuando la probabilidad era del 10%. Esto indica que lo que afecta el cumplimiento del Teorema del límite central es el tamaño de la muestra y no el aumento o disminución en la probabilidad de ocurrencia de un evento.

Finalmente, podemos afirmar que el estimador muestra la propiedad de consistencia porque se aproxima cada vez mas al verdadero valor del parámetro a medida que el tamaño muestral aumenta. Esto se observa en ambas simulaciones para lotes con 10% de plantas enfermas y para lotes con un 90% de plantas enfermas.