Problema 3

Problema 3: Teorema del límite central

CONSIDERACIONES INICIALES:

El teorema del límite central indica que, en muestras aleatorias e independientes, con media y varianza finitas, a medida que se aumenta el tamaño de la muestra, su distribución se asemeja cada vez a una distribución normal. Para probar la normalidad de una distribución existen varios métodos:

1. Graficamente: de forma visual se puede determinar, mediante histogramas, si la forma de su distribución se asemeja a una distribución normal.

2. Pruebas estadísticas: diferenetes pruebas estadísticas pueden determinar la normalidad o no normalidad de una muestra. Algunas de ellas son el test de Shapiro-Wilk, test de Kolmogorov-Smirnov o el test de Jarque-Bera.

Desarrollo del problema:

a. Se crea una muestra de 1000 registros los cuales contengan un 50% de plantas enfermas (1) y un 50% de plantas sanas (0).

n <- 1000
tamaños_muestra <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)

poblacion <- rep(0:1, n/2 )
table(poblacion)

## poblacion
##   0   1 
## 500 500

b. Se crea una función que obtenga una muestra aleatoria de los 1000 registros creados anteriormente y que calcule la proporción de plantas enfermas de esa muestra.

funcion_prop <- function(x, n){
  muestra <- sample(x = x, size = n)
  proporcion <- sum(muestra)/length(muestra)
  
  return(proporcion)
}

c. Se utiliza la función para calcular la proporción de plantas enfermas en una muestra determinada (en este caso se escogió una muestra de 500) y se repite el proceso 500 veces. Para esto se crea un ciclo for que guarde la proporción de cada iteración en un data frame vacío.

datos_500 <- data.frame(proporcion = numeric())

set.seed(1)
for (i in 1:500) {
  datos_500[i, 'proporcion'] <- funcion_prop(poblacion, 500)
}


head(datos_500)

##   proporcion
## 1      0.498
## 2      0.510
## 3      0.492
## 4      0.520
## 5      0.524
## 6      0.504

d. Se repite los procesos anteriores para muestras de n=5, 10, 15, 20, 30, 50, 60, 100, 200 y 500 y se comprueba si sigue una distribución normal mediante el test de Shapiro-Wilks o graficamente con histogramas.

lista_datos <- list(
  datos_5 = data.frame(proporcion = numeric()),
  datos_10 = data.frame(proporcion = numeric()),
  datos_15 = data.frame(proporcion = numeric()),
  datos_20 = data.frame(proporcion = numeric()),
  datos_30 = data.frame(proporcion = numeric()),
  datos_50 = data.frame(proporcion = numeric()),
  datos_60 = data.frame(proporcion = numeric()),
  datos_100 = data.frame(proporcion = numeric()),
  datos_200 = data.frame(proporcion = numeric()),
  datos_500 = data.frame(proporcion = numeric())
)


for (i in seq_along(lista_datos)) {
  tamaño_muestra <- tamaños_muestra[i]
  for (j in 1:500) {
    lista_datos[[i]][j, 'proporcion'] <- funcion_prop(poblacion, tamaño_muestra)
  }
}



resultados_shapiro <- list()

for (i in names(lista_datos)) {
  resultado <- shapiro.test(lista_datos[[i]][["proporcion"]])
  resultados_shapiro[[i]] <- resultado
  print(paste("Test Shapiro-Wilk para", i))
  print(resultado)
}

## [1] "Test Shapiro-Wilk para datos_5"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.92635, p-value = 5.997e-15
## 
## [1] "Test Shapiro-Wilk para datos_10"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.96237, p-value = 5.253e-10
## 
## [1] "Test Shapiro-Wilk para datos_15"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.97615, p-value = 2.787e-07
## 
## [1] "Test Shapiro-Wilk para datos_20"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.98162, p-value = 5.967e-06
## 
## [1] "Test Shapiro-Wilk para datos_30"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.98651, p-value = 0.0001388
## 
## [1] "Test Shapiro-Wilk para datos_50"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.99214, p-value = 0.009748
## 
## [1] "Test Shapiro-Wilk para datos_60"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.99043, p-value = 0.002474
## 
## [1] "Test Shapiro-Wilk para datos_100"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.9936, p-value = 0.03275
## 
## [1] "Test Shapiro-Wilk para datos_200"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.99571, p-value = 0.1894
## 
## [1] "Test Shapiro-Wilk para datos_500"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos[[i]][["proporcion"]]
## W = 0.9915, p-value = 0.00576

par(mfrow = c(2, 5))  

hist(lista_datos[["datos_5"]][["proporcion"]], main = "Datos 5", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_10"]][["proporcion"]], main = "Datos 10", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_15"]][["proporcion"]], main = "Datos 15", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_20"]][["proporcion"]], main = "Datos 20", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_30"]][["proporcion"]], main = "Datos 30", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_50"]][["proporcion"]], main = "Datos 50", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_60"]][["proporcion"]], main = "Datos 60", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_100"]][["proporcion"]], main = "Datos 100", xlab = "Proporción", col = "cyan")
hist(lista_datos[["datos_200"]][["proporcion"]], main = "Datos 200", xlab = "Proporción", col = "cyan")
hist(datos_500$proporcion, main = "Datos 500", xlab = "Proporción", col = "cyan")

Como se puede observar, entre mayor sea el número de la muestra, su distribución va convergiendo cada vez más hacia la normalidad de una forma más clara.

e. Ahora se repite los pasos anteriores pero con dos nuevos tipos de lote; el primero con un 10% y el segundo con un 90% de plantas enfermas.

# para 10% plantas enfermas
muestra1 <- c(rep(1, n * 0.1), rep(0, n * 0.9))
table(muestra1)

## muestra1
##   0   1 
## 900 100

datos_500_muestra1 <- data.frame(proporcion = numeric())

set.seed(1)
for (i in 1:500) {
  datos_500_muestra1[i, 'proporcion'] <- funcion_prop(muestra1, 500)
}



lista_datos2 <- list(
  datos_5 = data.frame(proporcion = numeric()),
  datos_10 = data.frame(proporcion = numeric()),
  datos_15 = data.frame(proporcion = numeric()),
  datos_20 = data.frame(proporcion = numeric()),
  datos_30 = data.frame(proporcion = numeric()),
  datos_50 = data.frame(proporcion = numeric()),
  datos_60 = data.frame(proporcion = numeric()),
  datos_100 = data.frame(proporcion = numeric()),
  datos_200 = data.frame(proporcion = numeric()),
  datos_500 = data.frame(proporcion = numeric())
)


for (i in seq_along(lista_datos2)) {
  tamaño_muestra <- tamaños_muestra[i]
  for (j in 1:500) {
    lista_datos2[[i]][j, 'proporcion'] <- funcion_prop(muestra1, tamaño_muestra)
  }
}


resultados_shapiro_3 <- list()

for (i in names(lista_datos2)) {
  resultado <- shapiro.test(lista_datos2[[i]][["proporcion"]])
  resultados_shapiro_3[[i]] <- resultado
  print(paste("Test Shapiro-Wilk para", i))
  print(resultado)
}

## [1] "Test Shapiro-Wilk para datos_5"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.68536, p-value < 2.2e-16
## 
## [1] "Test Shapiro-Wilk para datos_10"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.85861, p-value < 2.2e-16
## 
## [1] "Test Shapiro-Wilk para datos_15"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.89829, p-value < 2.2e-16
## 
## [1] "Test Shapiro-Wilk para datos_20"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.91825, p-value = 8.15e-16
## 
## [1] "Test Shapiro-Wilk para datos_30"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.95063, p-value = 7.163e-12
## 
## [1] "Test Shapiro-Wilk para datos_50"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.96916, p-value = 9.351e-09
## 
## [1] "Test Shapiro-Wilk para datos_60"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.98076, p-value = 3.582e-06
## 
## [1] "Test Shapiro-Wilk para datos_100"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.97776, p-value = 6.566e-07
## 
## [1] "Test Shapiro-Wilk para datos_200"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.98978, p-value = 0.001497
## 
## [1] "Test Shapiro-Wilk para datos_500"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos2[[i]][["proporcion"]]
## W = 0.99408, p-value = 0.04879

par(mfrow = c(2, 5))  

hist(lista_datos2[["datos_5"]][["proporcion"]], main = "Datos 5", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_10"]][["proporcion"]], main = "Datos 10", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_15"]][["proporcion"]], main = "Datos 15", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_20"]][["proporcion"]], main = "Datos 20", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_30"]][["proporcion"]], main = "Datos 30", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_50"]][["proporcion"]], main = "Datos 50", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_60"]][["proporcion"]], main = "Datos 60", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_100"]][["proporcion"]], main = "Datos 100", xlab = "Proporción", col = "cyan")
hist(lista_datos2[["datos_200"]][["proporcion"]], main = "Datos 200", xlab = "Proporción", col = "cyan")
hist(datos_500_muestra1$proporcion, main = "Datos 500", xlab = "Proporción", col = "cyan")

En el caso del de 10% de plantas enfermas, se observa la misma tendencia de converger hacia la normalidad a medida que se aumenta el tamaño de la muestra, sin embargo, dada la proporción desequilibrada de plantas enfermas, esta tiende a converger mas hacia una asimetria a la izquierda.

# para 90% plantas enfermas
muestra2 <- c(rep(1, n * 0.9), rep(0, n * 0.1))
table(muestra2)

## muestra2
##   0   1 
## 100 900

datos_500_muestra2 <- data.frame(proporcion = numeric())

set.seed(1)
for (i in 1:500) {
  datos_500_muestra2[i, 'proporcion'] <- funcion_prop(muestra2, 500)
}


lista_datos3 <- list(
  datos_5 = data.frame(proporcion = numeric()),
  datos_10 = data.frame(proporcion = numeric()),
  datos_15 = data.frame(proporcion = numeric()),
  datos_20 = data.frame(proporcion = numeric()),
  datos_30 = data.frame(proporcion = numeric()),
  datos_50 = data.frame(proporcion = numeric()),
  datos_60 = data.frame(proporcion = numeric()),
  datos_100 = data.frame(proporcion = numeric()),
  datos_200 = data.frame(proporcion = numeric()),
  datos_500 = data.frame(proporcion = numeric())
)


for (i in seq_along(lista_datos3)) {
  tamaño_muestra <- tamaños_muestra[i]
  for (j in 1:500) {
    lista_datos3[[i]][j, 'proporcion'] <- funcion_prop(muestra2, tamaño_muestra)
  }
}


resultados_shapiro_3 <- list()

for (i in names(lista_datos3)) {
  resultado <- shapiro.test(lista_datos3[[i]][["proporcion"]])
  resultados_shapiro_3[[i]] <- resultado
  print(paste("Test Shapiro-Wilk para", i))
  print(resultado)
}

## [1] "Test Shapiro-Wilk para datos_5"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.71876, p-value < 2.2e-16
## 
## [1] "Test Shapiro-Wilk para datos_10"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.82794, p-value < 2.2e-16
## 
## [1] "Test Shapiro-Wilk para datos_15"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.89236, p-value < 2.2e-16
## 
## [1] "Test Shapiro-Wilk para datos_20"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.91383, p-value = 2.902e-16
## 
## [1] "Test Shapiro-Wilk para datos_30"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.95495, p-value = 3.193e-11
## 
## [1] "Test Shapiro-Wilk para datos_50"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.96831, p-value = 6.405e-09
## 
## [1] "Test Shapiro-Wilk para datos_60"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.9777, p-value = 6.363e-07
## 
## [1] "Test Shapiro-Wilk para datos_100"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.98106, p-value = 4.276e-06
## 
## [1] "Test Shapiro-Wilk para datos_200"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.99154, p-value = 0.005957
## 
## [1] "Test Shapiro-Wilk para datos_500"
## 
##  Shapiro-Wilk normality test
## 
## data:  lista_datos3[[i]][["proporcion"]]
## W = 0.99429, p-value = 0.05854

par(mfrow = c(2, 5))  

hist(lista_datos3[["datos_5"]][["proporcion"]], main = "Datos 5", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_10"]][["proporcion"]], main = "Datos 10", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_15"]][["proporcion"]], main = "Datos 15", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_20"]][["proporcion"]], main = "Datos 20", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_30"]][["proporcion"]], main = "Datos 30", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_50"]][["proporcion"]], main = "Datos 50", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_60"]][["proporcion"]], main = "Datos 60", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_100"]][["proporcion"]], main = "Datos 100", xlab = "Proporción", col = "cyan")
hist(lista_datos3[["datos_200"]][["proporcion"]], main = "Datos 200", xlab = "Proporción", col = "cyan")
hist(datos_500_muestra2$proporcion, main = "Datos 500", xlab = "Proporción", col = "cyan")

Por otro lado, en el caso del de 90% de plantas enfermas, a medida que aumenta el tamaño de muestra se muestra una distribición asimetrica más clara hacia la derecha.

CONCLUSIONES FINALES:

para 50% de plantas enfermas:

A medida que se va aumentando el número de la muestra, este va convergiendo hacia una distribución normal. En el ejercicio esto se consiguió en muestras de 200 o mayores. La forma gráfica, si bien es un método visual para determinar la normalidad, resulta mas preciso aplicar el test de Shapiro-Wilk, el cual solo obtuvo un p-valor menor al 5% (valor tomado como referencia) en la muestra de 200.

para 90% y 10% de plantas enfermas:

Al aplicar tanto el test de Shapiro-Wilk como el análisis gráfico por medio de histogramas, no se puede afirmar que convergen hacia una distribución normal a medida que aumenta el número de muestras. En ambos casos se sigue una distribución con forma asimétrica, en un caso para la izquierda y en el otro para la derecha.

Problema 3

Jorge Iván Gómez

2023-09-18

Problema 3: Teorema del límite central