library(e1071)

Explicación

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:

  1. Realice una simulación en la cual genere una población de \(n=1000\) (Lote), donde el porcentaje de individuos (supongamos plantas) enfermas sea del 50%.

  2. Genere una función que permita:

  • Obtener una muestra aleatoria de la población y

  • Calcule el estimador de la proporción muestral \(\hat {p}\) para un tamaño de muestra dado \(n\).

  1. Repita el escenario anterior (2) \(n=500\) veces y analice los resultados en cuanto al comportamiento de los \(500\) resultados del estimador \(\hat {p}\). ¿Qué tan simétricos o sesgados son los resultados obtenidos?y ¿qué se puede observar en cuanto a la variabilidad?. Realice en su informe un comentario sobre los resultados obtenidos.

  2. Repita los puntos 2 y 3 para tamaños de muestra \(n = 50, 10, 15, 20, 30, 50, 60, 100, 200, 500\). Compare los resultados obtenidos para los diferentes tamaños de muestra en cuanto a la normalidad. Utilice pruebas de bondad y ajuste (shapiro wilks :shspiro.test()) y métodos gráficos (gráfico de normalidad: qqnorm()). Comente en su informe los resultados obtenidos

  3. Repita toda la simulación (puntos 1 – 4), pero ahora para lotes con 10% de plantas enfermas y de nuevo para lotes con un 90% de plantas enfermas. Concluya sobre los resultados del ejercicio.

Nota:

  • funciones recomendadas : rbinom() , data.frame(), apply()

Solución

Definición de las funciones a utilizar

Función 1: Esta función se encarga de realizar dos tareas; tomar una muestra aleatoria de la población y calcular el estimador de la proporción de plantas enfermas en la muestra.

cal_pro_muestral_enferma <- function(poblacion, tamanio_muestra) {
  muestra <- sample(poblacion, size = tamanio_muestra, replace = FALSE)
  return(sum(muestra == "enferma") / tamanio_muestra)
}

Función 2: Esta función se encarga de llevar a cabo el muestreo con un tamaño de muestra definido por el parámetro n_muestra y repetir este proceso una cantidad específica de veces según el parámetro n_simulaciones.

muestreo <- function(poblacion_, n_muestra, n_simulaciones) {
  vector_resultados <- numeric(n_simulaciones)
  for (i in 1:n_simulaciones) {
    vector_resultados[i] <- cal_pro_muestral_enferma(
      poblacion = poblacion_,
      tamanio_muestra = n_muestra
    )
  }
  return(vector_resultados)
}

Función 3: Función encargada de realizar las simulaciones con diferentes valores de n

simulacion_diferente_n <- function(vector_n, poblacion__) {
  
  #Creando un bucle for para generar los experimentos con los diferentes tamaños de muestras
  for (i in 1:length(vector_n)) {
    #Creando las simulaciones para cada tamaño de muestra
    simulacion <- muestreo(
      poblacion_ = poblacion__, 
      n_muestra = vector_n[i], 
      n_simulaciones = 500
    )
    
    #Graficando los resultados
    hist(
      simulacion,
      main = sprintf("Simulacion para n = %d", vector_n[i]),
      xlab = "Proporcion plantas enfermas",
      ylab = "Frecuencia"
    )
    
    #Coeficiente de asimetria
    print(sprintf("Coeficiente de asimetria: %.2f", skewness(simulacion)))
    
    #Prueba Shapiro
    print(sprintf("Prueba Shapiro Wilks: %.2f", shapiro.test(simulacion)$p.value))
    
    #Coeficiente de variación
    cof_var <- (sd(simulacion) / mean(simulacion)) * 100
    print(sprintf("Coeficiente de variacion: %.2f%%", cof_var))
  }
}

Generando la población

A continuación, crearemos una población compuesta por 1000 individuos. En este escenario, consideraremos que estos individuos representan plantas y que aproximadamente el 50% de ellas estarán enfermas.

set.seed(123)
simulacion_poblacion <- sample(
  c("enferma", "No enferma"), 
  size = 1000, 
  replace = TRUE,
  prob = c(0.5, 0.5)
)

Presentando las proporciones de plantas saludables y enfermas en la población.

tabla <- data.frame(table(simulacion_poblacion))

fig_poblacion <- barplot(
  tabla$Freq,
  names.arg = tabla$simulacion_poblacion,
  xlab = "Estado de las plantas",
  ylab = "Cantidad de plantas",
  main = "Cantidad de plantas sanas y enfermas",
  ylim = c(0, 700)
)

text(
  x = fig_poblacion,
  y = tabla$Freq,
  pos = 3,
  cex = 0.8,
  col = 'red',
  labels = tabla$Freq
)

Realizar un muestreo con \(n=500\), unas \(500\) veces

simulacion_n_500 <- muestreo(
  poblacion_ = simulacion_poblacion, 
  n_muestra = 500, 
  n_simulaciones = 500
)

Graficando los resultados de los datos con un histograma para ver la distribución de los datos

hist(
  simulacion_n_500,
  main = "Simulacion para n = 500",
  xlab = "Proporcion plantas enfermas",
  ylab = "Frecuencia"
)

Cálculo del coeficiente de asimetría o sesgo

print(sprintf("Coeficiente de asimetria: %.2f", skewness(simulacion_n_500)))
## [1] "Coeficiente de asimetria: -0.04"

Realización de la prueba de Shapiro Wilks

print(sprintf("Prueba Shapiro Wilks: %.2f", shapiro.test(simulacion_n_500)$p.value))
## [1] "Prueba Shapiro Wilks: 0.40"

Cálculo del coeficiente de variación

cof_var <- (sd(simulacion_n_500) / mean(simulacion_n_500)) * 100
print(sprintf("Coeficiente de variacion: %.2f%%", cof_var))
## [1] "Coeficiente de variacion: 3.32%"

¿Qué tan simétricos o sesgados son los resultados obtenidos? Si consideramos un valor de p estándar de 0.05, podemos observar que la prueba de Shapiro sugiere que los datos siguen una distribución normal. Esta afirmación se respalda aún más por un coeficiente de asimetría de -0.04, lo que indica una alta simetría en los datos.

¿Qué se puede observar en cuanto a la variabilidad? Si aplicamos la regla general que establece que un conjunto de datos se considera homogéneo cuando su coeficiente de variación es menor o igual al 20%, es evidente que los datos muestran una variabilidad muy baja, con un coeficiente de variación de tan solo 3.32%.

Muestreo con diferentes tamaños de \(n\)

simulacion_diferente_n(
  vector_n = c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500),
  poblacion__ = simulacion_poblacion
)

## [1] "Coeficiente de asimetria: -0.04"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 42.34%"

## [1] "Coeficiente de asimetria: -0.05"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 32.28%"

## [1] "Coeficiente de asimetria: 0.06"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 24.36%"

## [1] "Coeficiente de asimetria: 0.05"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 21.73%"

## [1] "Coeficiente de asimetria: 0.02"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 17.98%"

## [1] "Coeficiente de asimetria: -0.14"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 13.34%"

## [1] "Coeficiente de asimetria: 0.05"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 12.45%"

## [1] "Coeficiente de asimetria: -0.10"
## [1] "Prueba Shapiro Wilks: 0.03"
## [1] "Coeficiente de variacion: 9.66%"

## [1] "Coeficiente de asimetria: -0.09"
## [1] "Prueba Shapiro Wilks: 0.02"
## [1] "Coeficiente de variacion: 6.68%"

## [1] "Coeficiente de asimetria: -0.01"
## [1] "Prueba Shapiro Wilks: 0.27"
## [1] "Coeficiente de variacion: 3.09%"

Se pueden destacar las siguientes observaciones:

  • A partir de una muestra de 30 elementos seleccionados (n=30), se observa una variabilidad muy baja en los resultados, con un coeficiente de variación que es menor o igual al 20%.

  • Es evidente que, independientemente del tamaño de la muestra, todos los resultados muestran un comportamiento simétrico, ya que los coeficientes de simetría son cercanos a 0 en todos los casos. Sin embargo, de acuerdo con las pruebas de Shapiro, solo en la simulación con un tamaño de muestra igual a 500 se obtiene una distribución que sigue la normal, con un valor p estándar de 0.05.

  • También es notable que la proporción de plantas enfermas en cada muestra se asemeja de manera significativa a la proporción de plantas enfermas en toda la población.

Simulación para lotes con 10% de plantas enfermas

Generando una población de 1000 plantas, de las cuales el 10% están enfermas.

set.seed(123)
simulacion_poblacion_10 <- sample(
  c("enferma", "No enferma"), 
  size = 1000, 
  replace = TRUE,
  prob = c(0.1, 0.9)
)

Presentando las proporciones de plantas saludables y enfermas en la población.

tabla <- data.frame(table(simulacion_poblacion_10))

fig_poblacion <- barplot(
  tabla$Freq,
  names.arg = tabla$simulacion_poblacion,
  xlab = "Estado de las plantas",
  ylab = "Cantidad de plantas",
  main = "Cantidad de plantas sanas y enfermas",
  ylim = c(0, 1100)
)

text(
  x = fig_poblacion,
  y = tabla$Freq,
  pos = 3,
  cex = 0.8,
  col = 'red',
  labels = tabla$Freq
)

Muestreo con diferentes tamaños de \(n\)

simulacion_diferente_n(
  vector_n = c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500),
  poblacion__ = simulacion_poblacion_10
)

## [1] "Coeficiente de asimetria: 1.34"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 146.37%"

## [1] "Coeficiente de asimetria: 0.97"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 102.40%"

## [1] "Coeficiente de asimetria: 0.50"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 76.92%"

## [1] "Coeficiente de asimetria: 0.62"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 66.27%"

## [1] "Coeficiente de asimetria: 0.21"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 53.55%"

## [1] "Coeficiente de asimetria: 0.38"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 42.60%"

## [1] "Coeficiente de asimetria: 0.31"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 39.75%"

## [1] "Coeficiente de asimetria: 0.06"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 29.68%"

## [1] "Coeficiente de asimetria: 0.15"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 19.50%"

## [1] "Coeficiente de asimetria: -0.06"
## [1] "Prueba Shapiro Wilks: 0.08"
## [1] "Coeficiente de variacion: 10.43%"

Simulación para lotes con 90% de plantas enfermas

Generando una población de 1000 plantas, de las cuales el 90% están enfermas.

set.seed(123)
simulacion_poblacion_90 <- sample(
  c("enferma", "No enferma"),
  size = 1000,
  replace = TRUE,
  prob = c(0.9, 0.1)
)

Presentando las proporciones de plantas saludables y enfermas en la población.

tabla <- data.frame(table(simulacion_poblacion_90))

fig_poblacion <- barplot(
  tabla$Freq,
  names.arg = tabla$simulacion_poblacion,
  xlab = "Estado de las plantas",
  ylab = "Cantidad de plantas",
  main = "Cantidad de plantas sanas y enfermas",
  ylim = c(0, 1100)
)

text(
  x = fig_poblacion,
  y = tabla$Freq,
  pos = 3,
  cex = 0.8,
  col = 'red',
  labels = tabla$Freq
)

Muestreo con diferentes tamaños de \(n\)

simulacion_diferente_n(
  vector_n = c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500),
  poblacion__ = simulacion_poblacion_90
)

## [1] "Coeficiente de asimetria: -1.34"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 14.83%"

## [1] "Coeficiente de asimetria: -0.97"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 9.39%"

## [1] "Coeficiente de asimetria: -0.50"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 7.84%"

## [1] "Coeficiente de asimetria: -0.62"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 6.96%"

## [1] "Coeficiente de asimetria: -0.21"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 5.74%"

## [1] "Coeficiente de asimetria: -0.38"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 4.39%"

## [1] "Coeficiente de asimetria: -0.31"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 4.04%"

## [1] "Coeficiente de asimetria: -0.06"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 3.05%"

## [1] "Coeficiente de asimetria: -0.15"
## [1] "Prueba Shapiro Wilks: 0.00"
## [1] "Coeficiente de variacion: 1.95%"

## [1] "Coeficiente de asimetria: 0.06"
## [1] "Prueba Shapiro Wilks: 0.08"
## [1] "Coeficiente de variacion: 1.06%"

Independientemente de la proporción de plantas enfermas en la población, el teorema del límite central permite estimar este valor con gran precisión. Se reconoce que a medida que aumenta el tamaño de la muestra, la precisión de la estimación también mejora. En la población con el 10% de plantas enfermas (representada en la simulación con un 9.2%), se observa que la estimación se acerca considerablemente al valor real. Esto mismo se aprecia en el caso de la población con el 90% de plantas enfermas.