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

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

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%.

Solución:

Con el siguiente de código se realiza la simulación solicitada de las plantas donde la mitad de ellas están enfermas y la otra mitad sanas.

set.seed(123)

n = 10 ##Población de plantas
repeticion = 500

estado <- c("Sana","Enferma")
probabilidad <- c(0.5,0.5)

##Desarrollo del punto a con la simulación del 50% de las plantas enfermas
simulacion <- sample(estado,size = n,prob =probabilidad, replace = "TRUE")

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.

Solución:

Se crea la función con el siguiente código que tiene como parámetros el estado de la muestra (enferma o sana), cantidad de repeticiones y el tamaño de la población, al final del ejercicio la función retorna un vector con la proporción muestral calculada de cada repetición.

mi_funcion <- function(simulacion,n,repeticion){

  ##Crea el vector para guardar cada una de las proporciones muestrales
  proporcion_muestral <- numeric(repeticion)
  
  
  for (j in 1:repeticion) {
    ##Obtener una muestra aleatoria de la población
    aleatoria <- sample(simulacion,size = n,replace = "TRUE") 
    i = 1
    k = 0
    while(i < n){
      if(aleatoria[i]=="Enferma"){
        k=k+1
      }
      i=i+1
    }
    proporcion_muestral[j] =k/n ##Calcula la proporción muestral que es la división de los casos exitoso y el tamaño de la muestra
    datos <- proporcion_muestral
  }
  ##Se sacan los cálculos del promedio, mediana y la moda para poder realizar el análisi de simetría
  promedio <- mean(datos)
  mediana <- median(datos)
  moda <- datos[which.max(datos)]
  
  
  ##Se sanca los valores de rango y desviación estándar para realizar el análisi de variabilidad
  rango <- max(datos)-min(datos)
  desv <- sd(datos)
  
  ##Se imprimen los medidores de tendencia central
  print(moda)
  print(promedio)
  print(mediana)
  
  ##Se imprimen los medidores de variabilidad
  print(desv)
  print(rango)
    
  return(list(param1=proporcion_muestral,param2 = promedio, param3 = mediana, param4 = moda, param5 = desv))  ##Retorna la proporción muestral y los medidores de tendencia central y dispersión
}

##La función retorna el estimador de la proporción muestral
est <- mi_funcion(simulacion,n,repeticion)

En la ejecución de este código se tomó un tamaño n=10 con 1 repetición.

Repita el escenario anterior (b)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.

Solución:

Con la función definida en el punto b, se cambiaron los parámetros con las 500 repeticiones solicitadas generando el siguiente histograma.

## El valor del promedio es: 0.3562

## El valor de la mediana es: 0.3

## El valor de la moda es: 0.8

## El valor de la desviación estándar es: 0.1380568

De acuerdo al histograma mostrado en la gráfica anterior se logra evidenciar que la muestra de tamaño n =10 y 500 repeticiones es asimétrica a la izquierda teniendo en cuenta que los indicadores de tendencia central como la media, mediana y moda no son iguales y se logra mostrar por medio del histograma que hay una mayor concentración de datos a la izquierda del promedio.

Respecto a la variabilidad de la muestra se tomó el medidor de variabilidad de la desviación estándar mostrando que este tiene una desviación de 0.13 respecto a la media por cada proporción muestral, la media como se mencionó anteriormente es 0.35.

Repita los puntos b y c para tamaños de muestra n = 5, 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.

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.90479, p-value < 2.2e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.95872, p-value = 1.271e-10

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.97033, p-value = 1.596e-08

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.97775, p-value = 6.523e-07

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98523, p-value = 5.831e-05

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.9891, p-value = 0.0008918

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.99192, p-value = 0.008087

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.99373, p-value = 0.03642

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.99447, p-value = 0.06768

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.99707, p-value = 0.5153

De acuerdo con las pruebas de bondad y ajuste (shapiro wilks) que se aplicaron para cada uno de los tamaños de las muestras y los resultados de las simulaciones, se logra demostrar que el valor W entre menor es el tamaño de la muestra más lejos del valor 1 se encuentra, es así como con n = 5 el valor W es 0,90 mientras que cuando va aumentanto el tamaño de la misma este valor va disminuyendo hata cerrar con n = 500 y el valor W en 0,99.

De la misma manera el gráfico de normalidad qqnorm permite validar facilmente lo mencionado anteriormente, las primeras muestras muestran un sesgo importante hacia la izquierda lo que muestra una asimetría en los datos, sin embargo, conforme aumenta el tamaño de la misma los datos se alínean a la línea diagonal que representa la distribución normal teórica.

Repita toda la simulación (puntos a - d), pero ahora para lotes 10% de plantas enfermas y de nuevo para lotes con 90% de plantas enfermas. Concluya sobre los resultados del ejercicio.

Solución 1:

A continuación se realiza el desarrollo para el supuesto del 10% de las plantas enfermas.

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.80571, p-value < 2.2e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.80841, p-value < 2.2e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.91916, p-value = 1.011e-15

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.91906, p-value = 9.877e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.91503, p-value = 3.825e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.95121, p-value = 8.702e-12

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98088, p-value = 3.834e-06

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98967, p-value = 0.001372

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98975, p-value = 0.001465

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.99503, p-value = 0.1086

Al realizar la modificación en la muestra se ve una disminución muy marcada en la prueba de bondad y ajuste shapiro.test(), ya que suponer que el 10% de las plantas esten enfermas la primera simulación con n=5 da como resultado 0,80 lo que disminuye en 10 puntos el valor que se obtuvo en la revisón previa. Por otro lado el método gráfico qqnorm muestra muchos más datos hacia la izquierda, situación que no pasa con la incidencia de enfermas o sanas del 50%, esto quiere decir que entre más muestras tengamos del total de la población, mayor certeza tendremos de los datos que se analizan.

Solución 2

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.80571, p-value < 2.2e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.80841, p-value < 2.2e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.91916, p-value = 1.011e-15

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.91906, p-value = 9.877e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.91503, p-value = 3.825e-16

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.95121, p-value = 8.702e-12

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98088, p-value = 3.834e-06

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98967, p-value = 0.001372

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.98975, p-value = 0.001465

resultado <- shapiro.test(est$param1)
print(resultado)

## 
##  Shapiro-Wilk normality test
## 
## data:  est$param1
## W = 0.99503, p-value = 0.1086

Solución 2:

En este caso se evidencian más registros aleatorios hacia la derecha indicado de igual manera que los datos son asimétricos y quedando alejandos de la media principalmente en los primeros registos.

Problema 3 - Teorema del límite central

Laura Marcela Vásquez López - Fabián Andrés Castro Salazar

2024-03-17