El proceso de simulación constituye una herramienta poderosa para la estadística que se pueden emplear para entender relaciones complejas y estimar valores difíciles de calcular directamente. Para entenderlo utilizaremos se plantean los siguientes problemas:

0.1 Problema 1

Estimación del valor de \(\pi\)

La siguiente figura sugiere como estimar el valor de \(\pi\) con una simulación. En la figura, un circuito con un área igual a \(\frac{\pi}{4}\), está inscrito en un cuadrado cuya área es igual a 1. Se elige de forma aleatoria \(n\) puntos dentro del cuadrado. La probabilidad de que un punto esté dentro del círculo es igual a la fracción del área del cuadrado que abarca a este, la cual es \(\frac{\pi}{4}\). Por tanto, se puede estimar el valor de \(\frac{\pi}{4}\) al contar el número de puntos dentro del círculo, para obtener la estimación de \(\frac{\pi}{4}\). De este último resultado se encontrar una aproximación para el valor de \(\pi\).

Pasos sugeridos:

0.1.1 Paso 1

Genere \(n\) coordenadas \(x:X_1,...,X_n\). Utilice la distribución uniforme con valor mínimo de 0 y valor máximo de 1. La distribución uniforme genera variables aleatorias que tienen la misma probabilidad de venir de cualquier parte del intervalo (0,1).

Para este punto se utilizará La función \(runif\) permite obtener \(n\) observaciones aleatorias de una distribución uniforme entre el intervalo (0,1). Adicionalmente, se probarán diferentes valores para \(n\).

par(mfrow = c(1, 3))

x <- seq(-0.5, 1.5, 0.01)

set.seed(1)

# n = 1000
hist(runif(1000), main = "n = 1000", xlim = c(-0.2, 1.25),
     xlab = "", prob = TRUE)
lines(x, dunif(x), col = "red", lwd = 2)

# n = 10000
hist(runif(10000), main = "n = 10000", xlim = c(-0.2, 1.25),
     xlab = "", prob = TRUE)
lines(x, dunif(x), col = "red", lwd = 2)

# n = 100000
hist(runif(100000), main = "n = 100000", xlim = c(-0.2, 1.25),
     xlab = "", prob = TRUE)
lines(x, dunif(x), col = "red", lwd = 2)

0.1.2 Paso 2

Genere 1000 coordenadas \(y:Y_1,...,Y_n\), utilizando nuevamente la distribución uniforme con valor mínimo de 0 y valor máximo de 1

Para este punto se utilizará La función \(runif\) permite obtener \(n\) observaciones aleatorias de una distribución uniforme entre el intervalo (0,1).

par(mfrow = c(1, 3))

set.seed(1)

y=runif(1000, min = 0, max = 1)

# n = 1000
hist(y, main = "n = 1000", xlim = c(-0.2, 1.25),
     xlab = "", prob = TRUE)

0.1.3 Paso 3

Cada punto \((X_i, Y_i)\) se encuentra dentro del círculo si su distancia desde el centro \((0.5, 0.5)\) es menor a \(0.5\). Para cada par \((X_i, Y_i)\) determine si la distancia desde el centro es menor a \(0.5\). Esto último se puede realizar al calcular el valor \((X_i-0.5)^{2} + (Y_i-0.5)^{2}\), que es el cuadrado de la distancia, y al determinar si es menor que \(0.25\).

Para reolver este punto se gráfican cada uno de los puntos de \((X_i, Y_i)\) dentro de un circulo con radio \(0.5\).

y=runif(1000, min = 0, max = 1)
x=runif(1000, min = 0, max = 1)

rad     <- 0.5   # Valor del radio
xcenter <- 0.5  # Coordenada en x del centro
ycenter <- 0.5   # Coordenada en y del centro

theta <- seq(0, 2 * pi, length = 100)
plot(x,y, lines(x=rad * cos(theta) + xcenter,
                   y=rad * sin(theta) + ycenter, type = "l", lwd = 3, col="red"), lwd=1, col="black")

Gráficamente se observa que varios de los puntos generados para \((X_i, Y_i)\) se encuentran fuera de un circulo con radio \(0.5\). Ahora, se procede a calcular el valor \((X_i-0.5)^{2} + (Y_i-0.5)^{2}\), que es el cuadrado de la distancia y determinar si es menor que \(0.25\).

Gráficamente tenemos que:

y=runif(1000, min = 0, max = 1)
x=runif(1000, min = 0, max = 1)

x_1=1:1000

y_1=1:1000
y_1=(y_1/y_1)*0.25


Distancia=function(x,y){((x-0.5)^2)+((y-0.5)^2)}

plot(Distancia(x,y), lwd=1, col="black")
lines(x_1,y_1, type = "l", col="red")

El número de puntos por debajo de 0.25 es 746

p=Distancia(x,y)
sum(p<= 0.25)
## [1] 746

0.1.4 Paso 4

¿Cuántos de los puntos están dentro del círculo? ¿Cuál es su estimación de \(\pi\)?

El número de puntos dentro del círculo, es 746, como se presentó en el punto anterior. Dado que se trabajó con 1000 repeticiones, se divide el número de puntos dentro del círculo entre el total de puntos, obteniendo \(\frac{\pi}{4} = 0.746\). Por tanto, \(\pi = 4(0.746)\) y \(\pi = 2.98\)

0.2 Problema 2

Propiedades de los estimadores

La simulación ayuda a entender y validad las propiedades de los estimadores estadísticos como son. insesgadez, eficiencia y la consistencia principalmente. El siguiente problema permite evidenciar las principales características de un grupo de estimadores propuestos para la estimación de un parámetro asociado a un modelo de probabilidad.

Sea \(X_1,X_2,X_3 y X_4\) una muestra aleatoria de tamaño \(n=4\) cuya población la conforma una distribución exponencial con parámetro \(\theta\) desconocido. Determine las características de cada uno de los siguientes estimadores propuestos:

\(\widehat{\theta_1} = \frac{X_1+X_2}{6} + \frac{X_3+X_4}{3}\)

\(\widehat{\theta_2} = \frac{X_1+2X_2+3X_3+4X_4}{5}\)

\(\widehat{\theta_3} = \frac{X_1+X_2+X_3+X_4}{4}\)

\(\widehat{\theta_4} = \frac{\min\{X_1,X_2,X_3,X_4\}+\max\{X_1,X_2,X_3,X_4\}}{2}\)

0.2.1 Propiedades de los estimadores

Estimador insesgado: Un estimador \(\widehat{\theta_i}\) se considera insesgado si \(E[\widehat{\theta_i}] = \theta\).

Estimador eficiente: Sean \(\widehat{\theta_1}\) y \(\widehat{\theta_2}\) dos estimadores insesgados de \(\theta\), obtenidos en muestras del mismo tamaño. Se dice que \(\widehat{\theta_1}\) es más eficiente que \(\widehat{\theta_2}\), si la varianza de \(\widehat{\theta_1}\) es menor que la de \(\widehat{\theta_2}\).

Estimador consistente: Un estimador \(\widehat{\theta_i}\) de \(\theta\) es consistente para \(\theta\) si sus valores tienden a acercarse al parámetro poblacional \(\theta\) conforme se incrementa el tamaño de la muestra. De otro modo, el estimador se llama inconsistente.

n=4
n_muestras=20
theta <- 10
x=matrix(rexp(n*n_muestras, rate= 1/theta), nrow=n_muestras) 
Estimador_1 = function(x){(x[1] + x[2])/6 + (x[3] + x[4])/3}
Estimador_2 = function(x) (x[1] + 2*x[2] + 3*x[3] + 4*x[4])/5
Estimador_3 = function(x) sum(x)/4
Estimador_4 = function(x) (min(x) + max(x))/2

T1=matrix(apply(x,1,Estimador_1), nrow=n_muestras)
T2=matrix(apply(x,1,Estimador_2), nrow=n_muestras)
T3=matrix(apply(x,1,Estimador_3), nrow=n_muestras)
T4=matrix(apply(x,1,Estimador_4), nrow=n_muestras)

T1234=data.frame(T1, T2, T3, T4)

boxplot(T1234, las=1, main="Comparación estimadores con n=20")
abline(h=10,  col="red")  #línea indicando el parámetro theta

apply(T1234,2,mean)
##       T1       T2       T3       T4 
## 10.44032 20.63638 10.61342 11.45479
apply(T1234,2,var)  
##       T1       T2       T3       T4 
## 18.14581 75.46504 18.15367 17.34432

Para la primera estimación con tamaño de muestra \(n=20\), se observa que la media del estimador \(\widehat{\theta_1}\) el que más se acerca al valor asignado para \(\theta\). Asimismo, se observa que el estimador \(\widehat{\theta_4}\) es el que posee la menor varianza de los cuatro estimadores.

n=4
n_muestras=50
theta <- 10
x=matrix(rexp(n*n_muestras, rate= 1/theta), nrow=n_muestras) 
Estimador_1 = function(x){(x[1] + x[2])/6 + (x[3] + x[4])/3}
Estimador_2 = function(x) (x[1] + 2*x[2] + 3*x[3] + 4*x[4])/5
Estimador_3 = function(x) sum(x)/4
Estimador_4 = function(x) (min(x) + max(x))/2

T1=matrix(apply(x,1,Estimador_1), nrow=n_muestras)
T2=matrix(apply(x,1,Estimador_2), nrow=n_muestras)
T3=matrix(apply(x,1,Estimador_3), nrow=n_muestras)
T4=matrix(apply(x,1,Estimador_4), nrow=n_muestras)

T1234=data.frame(T1, T2, T3, T4)

boxplot(T1234, las=1, main="Comparación estimadores con n=50")
abline(h=10,  col="red")  #línea indicando el parámetro theta

apply(T1234,2,mean)
##        T1        T2        T3        T4 
##  7.874584 15.801297  8.205419  9.711403
apply(T1234,2,var)  
##       T1       T2       T3       T4 
## 15.26429 63.14482 18.00567 29.05393

Para la segunda estimación con tamaño de muestra \(n=50\), se observa que la media del estimador \(\widehat{\theta_4}\) el que más se acerca al valor asignado para \(\theta\). Asimismo, se observa que el estimador \(\widehat{\theta_1}\) es el que posee la menor varianza de los cuatro estimadores. Aquí unos resultados interesantes:

  • El estimador \(\widehat{\theta_4}\) con tamaño de \(n=50\) dejó de ser el estimador más cercano al valor asignado para \(\theta\) y se convirtió en el estimador con menor varianza.

  • El estimador \(\widehat{\theta_1}\) con tamaño de \(n=50\) dejó de ser el estimador con menor varianza y se convirtió en el estimador más cercano al valor asignado para \(\theta\).

Por otro lado, se observa que el estimador \(\widehat{\theta_2}\) con tamaño de muestra \(n=50\) comienza a converger al valor asignado para \(\theta\).

n=4
n_muestras=100
theta <- 10
x=matrix(rexp(n*n_muestras, rate= 1/theta), nrow=n_muestras) 
Estimador_1 = function(x){(x[1] + x[2])/6 + (x[3] + x[4])/3}
Estimador_2 = function(x) (x[1] + 2*x[2] + 3*x[3] + 4*x[4])/5
Estimador_3 = function(x) sum(x)/4
Estimador_4 = function(x) (min(x) + max(x))/2

T1=matrix(apply(x,1,Estimador_1), nrow=n_muestras)
T2=matrix(apply(x,1,Estimador_2), nrow=n_muestras)
T3=matrix(apply(x,1,Estimador_3), nrow=n_muestras)
T4=matrix(apply(x,1,Estimador_4), nrow=n_muestras)

T1234=data.frame(T1, T2, T3, T4)

boxplot(T1234, las=1, main="Comparación estimadores con n=100")
abline(h=10,  col="red")  #línea indicando el parámetro theta

apply(T1234,2,mean)
##        T1        T2        T3        T4 
##  9.322011 18.744410  9.426062 11.171207
apply(T1234,2,var)  
##        T1        T2        T3        T4 
##  26.61219 111.68853  26.08880  41.40808

Para la tercera estimación con tamaño de muestra \(n=100\), se observa que la media del estimador \(\widehat{\theta_3}\) es la que más se acerca al valor asignado para \(\theta\). Asimismo, este estimador es el que posee la menor varianza de los cuatro estimadores.

Por otro lado, se observa que el estimador \(\widehat{\theta_2}\) con tamaño de muestra \(n=100\) presenta un efecto rebote y se aleja del valor asignado para \(\theta\).

n=4
n_muestras=1000
theta <- 10
x=matrix(rexp(n*n_muestras, rate= 1/theta), nrow=n_muestras) 
Estimador_1 = function(x){(x[1] + x[2])/6 + (x[3] + x[4])/3}
Estimador_2 = function(x) (x[1] + 2*x[2] + 3*x[3] + 4*x[4])/5
Estimador_3 = function(x) sum(x)/4
Estimador_4 = function(x) (min(x) + max(x))/2

T1=matrix(apply(x,1,Estimador_1), nrow=n_muestras)
T2=matrix(apply(x,1,Estimador_2), nrow=n_muestras)
T3=matrix(apply(x,1,Estimador_3), nrow=n_muestras)
T4=matrix(apply(x,1,Estimador_4), nrow=n_muestras)

T1234=data.frame(T1, T2, T3, T4)

boxplot(T1234, las=1, main="Comparación estimadores con n=1000")
abline(h=10,  col="red")  #línea indicando el parámetro theta

apply(T1234,2,mean)
##        T1        T2        T3        T4 
##  9.820909 19.505119  9.836919 11.620073
apply(T1234,2,var)  
##        T1        T2        T3        T4 
##  26.81924 111.79336  24.86315  41.99599

Para la última estimación con tamaño de muestra \(n=1000\), se observa que la media del estimador \(\widehat{\theta_3}\) es la que más se acerca al valor asignado para \(\theta\). Asimismo, este estimador es el que posee la menor varianza de los cuatro estimadores.

Por otro lado, al revisar los resultados del estimador \(\widehat{\theta_3}\) con los diferentes tamaños de muestra se observa que cumple con la propiedad de consistencia, dado que con el crecimiento de la muestra converge al valor asignado para \(\theta\).

0.3 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:

0.3.1 Paso a.

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\%\)

lote = 1000 #Tamaño de la población 
rho = 0.5 #Este valor representa el porcentaje de plantas enfermas.

poblacion = rbinom(lote, 1, rho)

0.3.2 Paso b.

  1. Genere una función que permita:
  • Obtener una muestra aleatoria de la población y
  • Calcule el estimador de la proporción muestral \(\widehat{\rho}\) para un tamaño de muestra dado \(n\)
n<-20 # tamaño de las muestras a seleccionar
k<-1 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el rho de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(muestra=mat,
                    rho_hat=mediax)
 }

resultado
## $muestra
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,]    0    0    1    0    1    1    1    1    0     0     1     1     1     0
##      [,15] [,16] [,17] [,18] [,19] [,20]
## [1,]     1     1     1     0     1     0
## 
## $rho_hat
## [1] 0.6

0.3.3 Paso c.

Repita el escenario anterior (b) \(n=500\) veces y analice los resultados en cuanto al comportamiento de los 500 resultados del estimador \(\widehat{\rho}\). ¿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.

n<-20 # tamaño de las muestras a seleccionar
k<-500 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

resultado
## $rho_hat
##   [1] 0.55 0.60 0.45 0.55 0.60 0.60 0.50 0.60 0.60 0.65 0.60 0.45 0.30 0.35 0.65
##  [16] 0.60 0.55 0.25 0.70 0.40 0.55 0.35 0.55 0.30 0.35 0.55 0.65 0.35 0.30 0.50
##  [31] 0.35 0.50 0.35 0.60 0.50 0.50 0.35 0.35 0.50 0.45 0.40 0.35 0.45 0.55 0.60
##  [46] 0.70 0.45 0.55 0.70 0.50 0.60 0.55 0.50 0.50 0.55 0.70 0.55 0.55 0.65 0.60
##  [61] 0.70 0.45 0.55 0.45 0.50 0.55 0.45 0.40 0.65 0.50 0.65 0.65 0.50 0.65 0.50
##  [76] 0.65 0.40 0.55 0.60 0.55 0.55 0.50 0.50 0.35 0.45 0.65 0.50 0.40 0.55 0.70
##  [91] 0.45 0.50 0.50 0.55 0.40 0.45 0.45 0.40 0.60 0.35 0.35 0.50 0.45 0.45 0.30
## [106] 0.40 0.55 0.60 0.70 0.40 0.60 0.50 0.60 0.50 0.55 0.45 0.60 0.50 0.40 0.60
## [121] 0.75 0.40 0.60 0.50 0.50 0.55 0.55 0.50 0.40 0.60 0.40 0.85 0.50 0.50 0.55
## [136] 0.25 0.40 0.65 0.70 0.70 0.40 0.55 0.55 0.60 0.50 0.60 0.35 0.30 0.55 0.45
## [151] 0.35 0.65 0.40 0.60 0.45 0.35 0.45 0.30 0.70 0.50 0.65 0.55 0.40 0.55 0.45
## [166] 0.45 0.40 0.45 0.65 0.55 0.60 0.65 0.35 0.65 0.60 0.60 0.55 0.40 0.50 0.45
## [181] 0.35 0.40 0.45 0.40 0.65 0.50 0.65 0.55 0.65 0.40 0.40 0.45 0.30 0.60 0.70
## [196] 0.50 0.40 0.60 0.40 0.70 0.50 0.50 0.35 0.50 0.45 0.40 0.45 0.55 0.60 0.65
## [211] 0.50 0.55 0.55 0.60 0.65 0.45 0.60 0.65 0.45 0.60 0.55 0.35 0.50 0.60 0.55
## [226] 0.35 0.55 0.50 0.35 0.65 0.60 0.70 0.50 0.55 0.25 0.70 0.60 0.45 0.65 0.65
## [241] 0.60 0.60 0.50 0.40 0.60 0.55 0.60 0.60 0.60 0.45 0.45 0.40 0.55 0.40 0.55
## [256] 0.45 0.35 0.60 0.55 0.55 0.35 0.60 0.40 0.35 0.45 0.45 0.50 0.45 0.45 0.50
## [271] 0.60 0.60 0.45 0.50 0.60 0.45 0.60 0.55 0.30 0.35 0.60 0.50 0.50 0.20 0.40
## [286] 0.40 0.70 0.65 0.60 0.40 0.60 0.60 0.60 0.50 0.60 0.55 0.55 0.55 0.15 0.50
## [301] 0.30 0.45 0.50 0.45 0.40 0.55 0.75 0.55 0.65 0.50 0.55 0.65 0.35 0.50 0.55
## [316] 0.50 0.60 0.55 0.60 0.50 0.55 0.55 0.50 0.50 0.55 0.45 0.45 0.70 0.60 0.65
## [331] 0.55 0.35 0.65 0.30 0.55 0.40 0.45 0.50 0.70 0.30 0.65 0.55 0.50 0.65 0.50
## [346] 0.65 0.35 0.50 0.40 0.55 0.50 0.55 0.50 0.80 0.60 0.40 0.35 0.35 0.45 0.55
## [361] 0.80 0.50 0.65 0.50 0.65 0.55 0.35 0.55 0.60 0.50 0.55 0.50 0.45 0.60 0.45
## [376] 0.60 0.50 0.45 0.50 0.40 0.65 0.35 0.35 0.55 0.45 0.35 0.50 0.70 0.50 0.55
## [391] 0.45 0.35 0.60 0.35 0.55 0.60 0.65 0.40 0.30 0.55 0.55 0.60 0.50 0.40 0.30
## [406] 0.50 0.50 0.65 0.30 0.65 0.65 0.50 0.40 0.50 0.55 0.40 0.55 0.35 0.40 0.55
## [421] 0.50 0.40 0.35 0.50 0.55 0.45 0.65 0.25 0.25 0.60 0.60 0.45 0.50 0.45 0.40
## [436] 0.60 0.60 0.75 0.60 0.55 0.50 0.55 0.50 0.55 0.30 0.30 0.35 0.60 0.45 0.20
## [451] 0.45 0.35 0.60 0.55 0.40 0.65 0.50 0.60 0.35 0.55 0.55 0.45 0.60 0.40 0.55
## [466] 0.55 0.40 0.45 0.50 0.35 0.40 0.35 0.60 0.40 0.45 0.45 0.80 0.50 0.40 0.55
## [481] 0.70 0.45 0.55 0.40 0.65 0.65 0.40 0.40 0.55 0.45 0.65 0.45 0.40 0.45 0.45
## [496] 0.45 0.45 0.65 0.65 0.60
### Histograma para visualizar el comportamiento de los rho en cada muestra

par(mfrow = c(1, 2))

hist(mediax,probability=T,main="Histograma de los rho",xlab="") 
lines = plot(density(mediax), type = "l", col="red", main="Densidad de los valor de rho",xlab="")

En el histograma de los valores de \(\widehat{\rho}\) se observa que con un tamaño de muestra de \(n=500\), estos comienzan a tener una forma de campana, lo cual se valida en la gráfica de densidad la cual comienza a tomar una forma cercana a la distribución normal.

Por otro lado, al revisar los valores de la media y la varianza se observa que el primero se acerca al valor de \(\rho\) y el segundo es un valor muy bajo.

### Estimación Parámetros según el TLC ###
mean(mediax) #valor esperado de la media muestral
## [1] 0.5078
var(mediax) #varianza de la media muestral
## [1] 0.01253423
sd(mediax) #error estándar de la media muestral
## [1] 0.1119564

0.3.4 Paso d.

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

n<-20 # tamaño de las muestras a seleccionar
k<-5 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_5 <- shapiro.test(mediax)
a_5 <- mediax

#--------------

k<-10 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_10 <- shapiro.test(mediax)
a_10 <- mediax

#--------------

k<-15 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_15 <- shapiro.test(mediax)
a_15 <- mediax

#--------------

k<-20 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_20 <- shapiro.test(mediax)
a_20 <- mediax

#--------------

k<-30 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_30 <- shapiro.test(mediax)
a_30 <- mediax

#--------------
k<-50 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_50 <- shapiro.test(mediax)
a_50 <- mediax

#--------------

k<-60 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_60 <- shapiro.test(mediax)
a_60 <- mediax

#--------------

k<-100 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_100 <- shapiro.test(mediax)
a_100 <- mediax

#--------------

k<-200 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_200 <- shapiro.test(mediax)
a_200 <- mediax

#--------------

k<-500 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_500 <- shapiro.test(mediax)
a_500 <- mediax

#--------------

x.test_5
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.95296, p-value = 0.7583
x.test_10
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.93041, p-value = 0.4519
x.test_15
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.89529, p-value = 0.08068
x.test_20
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.95126, p-value = 0.3867
x.test_30
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.97722, p-value = 0.7478
x.test_50
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.96563, p-value = 0.1529
x.test_60
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.94776, p-value = 0.01224
x.test_100
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.96339, p-value = 0.007071
x.test_200
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.97386, p-value = 0.0008701
x.test_500
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.97905, p-value = 1.338e-06

De acuerdo con la prueba Shapiro-Wilk tenemos que:

\(H_0=\) La distribución es normal \(H_1=\) La distribución no es normal

Con base en lo anterior, los resultados de la prueba para las diferentes tamaños de muestra indican que, a medida que el tamaño de muestra aumenta el \(p-value\) disminuye y por tanto se rechaza la hipotesis nula. En este escenario, esto ocurre con valores de \(n>100\).

Por otro lado, la función \(qqnorm\) genera un gráfico \(Q-Q\) que compara los cuantiles de los datos con los cuantiles teóricos de la distribución normal estándar, N(0, 1).

La función \(qqline\) superpone una línea que nos ayuda a evaluar la relación lineal de las dos distribuciones. Esta línea, que por defecto cruza los puntos del primer (0,25) y el tercer cuartil (0,75), es una aproximación robusta de los valores esperados de nuestros datos si siguieran una distribución normal estándar. Si los datos se alejan de esta línea, especialmente cerca del centro, nos sugeriría que nuestros datos no se distribuyen normalmente.

par(mfrow = c(1, 2))


par(mfrow = c(2, 5))

qqnorm(a_5,main="qqnorm n=5",xlab="")
qqline(a_5, col ="red")
qqnorm(a_10,main="qqnorm n=10",xlab="")
qqline(a_10, col ="red")
qqnorm(a_15,main="qqnorm n=15",xlab="")
qqline(a_15, col ="red")
qqnorm(a_20,main="qqnorm n=20",xlab="")
qqline(a_20, col ="red")
qqnorm(a_30,main="qqnorm n=30",xlab="")
qqline(a_30, col ="red")
qqnorm(a_50,main="qqnorm n=50",xlab="")
qqline(a_50, col ="red")
qqnorm(a_60,main="qqnorm n=60",xlab="")
qqline(a_60, col ="red")
qqnorm(a_100,main="qqnorm n=100",xlab="")
qqline(a_100, col ="red")
qqnorm(a_200,main="qqnorm n=200",xlab="")
qqline(a_200, col ="red")
qqnorm(a_500,main="qqnorm n=500",xlab="")
qqline(a_500, col ="red")

Los resultados gráficos muestran que con el aumento de la muestra se asocia con una mejor aproximación de normalidad en los datos.

0.3.5 Paso e.

Repita toda la simulación (puntos a – d), 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.

0.3.5.1 rho = 0.1

0.3.5.2 paso a

lote = 1000 #Tamaño de la población 
rho = 0.1 #Este valor representa el porcentaje de plantas enfermas.

poblacion = rbinom(lote, 1, rho)

0.3.5.3 Paso b

n<-20 # tamaño de las muestras a seleccionar
k<-1 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el rho de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(muestra=mat,
                    rho_hat=mediax)
 }

resultado
## $muestra
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,]    0    0    0    0    0    0    0    0    0     0     0     1     1     1
##      [,15] [,16] [,17] [,18] [,19] [,20]
## [1,]     0     0     0     0     0     0
## 
## $rho_hat
## [1] 0.15

0.3.5.4 Paso c

n<-20 # tamaño de las muestras a seleccionar
k<-500 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

resultado
## $rho_hat
##   [1] 0.00 0.10 0.05 0.15 0.05 0.10 0.05 0.15 0.00 0.10 0.00 0.00 0.00 0.00 0.05
##  [16] 0.00 0.20 0.05 0.15 0.05 0.05 0.10 0.00 0.10 0.15 0.05 0.15 0.10 0.15 0.15
##  [31] 0.00 0.10 0.10 0.10 0.15 0.05 0.10 0.10 0.20 0.20 0.30 0.10 0.10 0.05 0.00
##  [46] 0.00 0.25 0.05 0.00 0.05 0.10 0.05 0.00 0.15 0.00 0.20 0.10 0.05 0.05 0.00
##  [61] 0.05 0.00 0.10 0.10 0.00 0.00 0.10 0.25 0.10 0.00 0.10 0.15 0.05 0.05 0.15
##  [76] 0.00 0.20 0.10 0.05 0.05 0.00 0.05 0.15 0.05 0.10 0.05 0.05 0.05 0.05 0.05
##  [91] 0.00 0.10 0.15 0.15 0.15 0.05 0.10 0.20 0.10 0.20 0.00 0.10 0.05 0.20 0.20
## [106] 0.05 0.10 0.05 0.15 0.10 0.10 0.15 0.10 0.10 0.00 0.10 0.05 0.15 0.10 0.15
## [121] 0.00 0.10 0.10 0.10 0.10 0.15 0.05 0.10 0.15 0.20 0.05 0.05 0.00 0.25 0.10
## [136] 0.15 0.15 0.05 0.10 0.10 0.05 0.15 0.05 0.10 0.05 0.05 0.15 0.15 0.05 0.05
## [151] 0.00 0.10 0.10 0.10 0.00 0.10 0.15 0.05 0.00 0.00 0.05 0.05 0.10 0.05 0.20
## [166] 0.15 0.00 0.20 0.10 0.00 0.05 0.00 0.05 0.00 0.05 0.10 0.05 0.00 0.00 0.05
## [181] 0.00 0.00 0.15 0.05 0.20 0.10 0.05 0.00 0.05 0.10 0.05 0.25 0.20 0.00 0.05
## [196] 0.10 0.10 0.05 0.30 0.15 0.05 0.10 0.10 0.15 0.05 0.15 0.10 0.10 0.00 0.05
## [211] 0.10 0.15 0.10 0.15 0.15 0.00 0.10 0.15 0.05 0.10 0.00 0.15 0.10 0.00 0.00
## [226] 0.00 0.10 0.20 0.10 0.05 0.00 0.10 0.15 0.10 0.05 0.15 0.05 0.20 0.05 0.05
## [241] 0.10 0.05 0.00 0.05 0.00 0.05 0.05 0.05 0.15 0.15 0.10 0.05 0.05 0.10 0.00
## [256] 0.05 0.15 0.00 0.15 0.10 0.05 0.05 0.00 0.00 0.05 0.15 0.20 0.15 0.05 0.10
## [271] 0.05 0.10 0.05 0.05 0.05 0.10 0.15 0.05 0.05 0.10 0.05 0.10 0.15 0.15 0.15
## [286] 0.05 0.05 0.20 0.10 0.00 0.05 0.00 0.05 0.00 0.20 0.10 0.05 0.10 0.05 0.05
## [301] 0.05 0.10 0.20 0.05 0.10 0.15 0.10 0.05 0.20 0.15 0.05 0.10 0.20 0.10 0.05
## [316] 0.05 0.05 0.05 0.15 0.10 0.05 0.05 0.05 0.00 0.05 0.10 0.10 0.25 0.05 0.05
## [331] 0.10 0.10 0.05 0.10 0.10 0.05 0.15 0.25 0.15 0.00 0.00 0.05 0.00 0.10 0.05
## [346] 0.00 0.10 0.25 0.05 0.05 0.05 0.00 0.15 0.15 0.10 0.05 0.00 0.10 0.15 0.10
## [361] 0.15 0.20 0.10 0.05 0.05 0.10 0.05 0.05 0.05 0.10 0.05 0.05 0.05 0.05 0.05
## [376] 0.10 0.10 0.05 0.10 0.15 0.10 0.00 0.15 0.10 0.05 0.15 0.15 0.10 0.10 0.10
## [391] 0.10 0.15 0.15 0.10 0.35 0.00 0.15 0.05 0.15 0.05 0.10 0.10 0.15 0.15 0.05
## [406] 0.15 0.05 0.05 0.05 0.15 0.15 0.00 0.05 0.05 0.05 0.00 0.05 0.15 0.05 0.05
## [421] 0.15 0.15 0.10 0.00 0.05 0.10 0.05 0.15 0.00 0.20 0.15 0.10 0.10 0.10 0.00
## [436] 0.00 0.10 0.10 0.05 0.20 0.00 0.05 0.10 0.10 0.05 0.10 0.05 0.10 0.10 0.05
## [451] 0.10 0.15 0.20 0.15 0.15 0.30 0.15 0.10 0.05 0.10 0.20 0.15 0.15 0.15 0.00
## [466] 0.00 0.05 0.05 0.05 0.05 0.15 0.05 0.00 0.20 0.05 0.15 0.10 0.00 0.00 0.00
## [481] 0.00 0.10 0.10 0.10 0.10 0.15 0.10 0.00 0.10 0.10 0.05 0.05 0.15 0.00 0.15
## [496] 0.10 0.15 0.10 0.15 0.05
### Histograma para visualizar el comportamiento de los rho en cada muestra

par(mfrow = c(1, 2))

hist(mediax,probability=T,main="Histograma de los rho",xlab="") 
lines = plot(density(mediax), type = "l", col="red", main="Densidad de los valor de rho",xlab="")

En el histograma de los valores de \(\widehat{\rho}\) se observa que con un tamaño de muestra de \(n=500\), estos comienzan a tener una forma de campana inclinada hacia la izquierda, lo cual se valida en la gráfica de densidad de los datos.

Por otro lado, al revisar los valores de la media y la varianza se observa que el primero se acerca al valor de \(\rho\) y el segundo es un valor muy bajo.

### Estimación Parámetros según el TLC ###
mean(mediax) #valor esperado de la media muestral
## [1] 0.0867
var(mediax) #varianza de la media muestral
## [1] 0.003915942
sd(mediax) #error estándar de la media muestral
## [1] 0.06257749

0.3.5.5 Paso d

n<-20 # tamaño de las muestras a seleccionar
k<-5 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_5 <- shapiro.test(mediax)
a_5 <- mediax

#--------------

k<-10 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_10 <- shapiro.test(mediax)
a_10 <- mediax

#--------------

k<-15 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_15 <- shapiro.test(mediax)
a_15 <- mediax

#--------------

k<-20 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_20 <- shapiro.test(mediax)
a_20 <- mediax

#--------------

k<-30 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_30 <- shapiro.test(mediax)
a_30 <- mediax

#--------------
k<-50 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_50 <- shapiro.test(mediax)
a_50 <- mediax

#--------------

k<-60 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_60 <- shapiro.test(mediax)
a_60 <- mediax

#--------------

k<-100 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_100 <- shapiro.test(mediax)
a_100 <- mediax

#--------------

k<-200 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_200 <- shapiro.test(mediax)
a_200 <- mediax

#--------------

k<-500 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_500 <- shapiro.test(mediax)
a_500 <- mediax

#--------------

x.test_5
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.91408, p-value = 0.4925
x.test_10
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.93308, p-value = 0.4788
x.test_15
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.92354, p-value = 0.2181
x.test_20
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.8648, p-value = 0.009531
x.test_30
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.89764, p-value = 0.007357
x.test_50
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.88958, p-value = 0.0002215
x.test_60
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.86763, p-value = 1.052e-05
x.test_100
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.90307, p-value = 1.976e-06
x.test_200
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.91832, p-value = 4.392e-09
x.test_500
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.90436, p-value < 2.2e-16

De acuerdo con la prueba Shapiro-Wilk tenemos que:

\(H_0=\) La distribución es normal \(H_1=\) La distribución no es normal

Con base en lo anterior, los resultados de la prueba para las diferentes tamaños de muestra indican que, a medida que el tamaño de muestra aumenta el \(p-value\) disminuye y por tanto se rechaza la hipotesis nula. En este escenario, esto ocurre con valores de \(n>20\).

Por otro lado, la función \(qqnorm\) genera un gráfico \(Q-Q\) que compara los cuantiles de los datos con los cuantiles teóricos de la distribución normal estándar, N(0, 1).

La función \(qqline\) superpone una línea que nos ayuda a evaluar la relación lineal de las dos distribuciones. Esta línea, que por defecto cruza los puntos del primer (0,25) y el tercer cuartil (0,75), es una aproximación robusta de los valores esperados de nuestros datos si siguieran una distribución normal estándar. Si los datos se alejan de esta línea, especialmente cerca del centro, nos sugeriría que nuestros datos no se distribuyen normalmente.

par(mfrow = c(1, 2))


par(mfrow = c(2, 5))

qqnorm(a_5,main="qqnorm n=5",xlab="")
qqline(a_5, col ="red")
qqnorm(a_10,main="qqnorm n=10",xlab="")
qqline(a_10, col ="red")
qqnorm(a_15,main="qqnorm n=15",xlab="")
qqline(a_15, col ="red")
qqnorm(a_20,main="qqnorm n=20",xlab="")
qqline(a_20, col ="red")
qqnorm(a_30,main="qqnorm n=30",xlab="")
qqline(a_30, col ="red")
qqnorm(a_50,main="qqnorm n=50",xlab="")
qqline(a_50, col ="red")
qqnorm(a_60,main="qqnorm n=60",xlab="")
qqline(a_60, col ="red")
qqnorm(a_100,main="qqnorm n=100",xlab="")
qqline(a_100, col ="red")
qqnorm(a_200,main="qqnorm n=200",xlab="")
qqline(a_200, col ="red")
qqnorm(a_500,main="qqnorm n=500",xlab="")
qqline(a_500, col ="red")

Los resultados gráficos muestran que con el aumento de la muestra se asocia con una mejor aproximación de normalidad en los datos.

0.3.5.6 rho = 0.9

0.3.5.7 paso a

lote = 1000 #Tamaño de la población 
rho = 0.9 #Este valor representa el porcentaje de plantas enfermas.

poblacion = rbinom(lote, 1, rho)

0.3.5.8 Paso b

n<-20 # tamaño de las muestras a seleccionar
k<-1 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el rho de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(muestra=mat,
                    rho_hat=mediax)
 }

resultado
## $muestra
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,]    1    1    1    1    1    1    0    1    1     1     1     1     1     1
##      [,15] [,16] [,17] [,18] [,19] [,20]
## [1,]     1     1     1     1     1     1
## 
## $rho_hat
## [1] 0.95

0.3.5.9 Paso c

n<-20 # tamaño de las muestras a seleccionar
k<-500 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

resultado
## $rho_hat
##   [1] 0.90 0.95 1.00 0.85 0.95 0.90 0.95 0.95 0.80 0.85 0.95 0.75 0.95 0.85 0.90
##  [16] 0.95 0.85 0.90 1.00 1.00 0.85 0.95 0.85 0.90 0.75 0.95 1.00 0.95 0.80 0.95
##  [31] 1.00 0.95 0.90 0.95 0.90 1.00 0.90 0.90 0.95 0.75 0.90 0.85 0.90 0.80 1.00
##  [46] 0.95 0.90 0.90 0.95 0.95 0.95 0.90 0.95 0.90 0.90 0.95 0.90 0.85 0.80 0.90
##  [61] 0.95 0.90 0.95 0.90 1.00 0.95 0.95 0.85 1.00 1.00 0.90 0.90 1.00 0.85 1.00
##  [76] 0.95 0.90 1.00 0.90 0.95 0.90 0.95 0.85 1.00 0.90 0.90 0.95 0.95 0.85 0.95
##  [91] 0.95 1.00 1.00 0.80 0.95 0.90 0.80 0.95 0.95 0.80 1.00 0.85 0.95 0.85 0.70
## [106] 0.85 0.95 1.00 0.95 1.00 1.00 1.00 0.90 0.90 0.95 0.85 0.95 0.90 0.95 0.90
## [121] 0.95 0.80 0.85 0.70 0.90 0.90 1.00 0.95 0.90 0.95 0.80 0.85 0.95 0.85 0.95
## [136] 0.90 0.80 0.80 0.80 0.85 0.90 0.90 0.90 0.85 0.95 0.85 0.95 0.90 0.80 0.90
## [151] 1.00 0.85 0.95 0.90 0.95 0.90 0.85 0.95 0.95 0.85 1.00 0.95 0.95 0.90 0.85
## [166] 1.00 0.70 0.85 0.90 0.95 0.95 0.95 1.00 0.85 0.95 0.90 0.95 0.90 1.00 0.95
## [181] 1.00 0.90 0.90 1.00 0.90 1.00 0.90 0.75 0.80 0.85 1.00 0.90 0.95 0.90 0.95
## [196] 0.95 0.90 0.95 0.95 0.90 1.00 0.95 0.90 0.90 0.95 0.95 0.95 0.95 0.90 0.85
## [211] 0.85 0.90 0.80 0.90 0.90 0.90 0.90 0.90 0.90 1.00 0.80 0.90 0.95 0.95 0.95
## [226] 0.90 0.95 0.95 0.95 1.00 0.95 1.00 0.95 0.95 0.95 0.90 1.00 0.80 1.00 1.00
## [241] 1.00 0.95 0.90 0.75 0.80 0.95 0.90 0.95 0.75 0.90 1.00 0.90 0.90 0.90 0.95
## [256] 0.95 0.95 0.90 0.85 0.85 0.80 0.90 0.90 1.00 1.00 0.90 0.80 0.90 0.80 1.00
## [271] 0.80 0.75 0.85 1.00 0.95 0.85 0.85 0.95 0.95 0.85 0.95 1.00 0.95 0.90 0.90
## [286] 0.90 0.85 1.00 0.95 0.95 0.85 0.75 0.85 0.95 0.90 0.90 0.90 0.95 0.85 0.85
## [301] 0.90 0.95 0.95 0.95 0.95 0.80 0.90 0.95 0.85 0.90 0.95 0.95 0.95 1.00 0.95
## [316] 0.95 0.85 0.95 0.90 0.80 0.85 0.95 0.95 0.85 0.90 0.85 1.00 0.90 0.85 1.00
## [331] 0.85 0.85 1.00 1.00 0.90 0.85 1.00 1.00 0.90 1.00 0.95 0.80 1.00 0.80 1.00
## [346] 0.95 0.90 0.90 1.00 1.00 0.95 0.95 1.00 0.95 0.95 0.95 1.00 0.95 0.85 0.90
## [361] 0.90 1.00 0.95 1.00 0.85 0.85 0.85 1.00 0.95 0.95 0.80 1.00 0.95 0.90 0.85
## [376] 0.95 0.75 0.90 0.85 0.85 0.90 0.95 1.00 0.85 0.95 0.70 0.90 1.00 0.90 0.95
## [391] 0.90 0.90 0.85 1.00 1.00 0.90 0.95 0.90 0.85 1.00 0.85 0.90 0.90 0.85 1.00
## [406] 0.90 0.90 0.90 0.90 0.90 1.00 0.95 0.85 0.95 0.90 0.90 0.85 1.00 0.90 1.00
## [421] 0.90 1.00 0.90 0.90 0.95 0.90 0.95 0.90 1.00 0.90 0.85 0.90 0.95 1.00 1.00
## [436] 1.00 1.00 0.85 0.95 1.00 0.90 0.95 0.80 0.95 0.90 0.90 0.85 0.90 0.85 0.75
## [451] 0.80 0.90 0.95 0.95 0.90 0.90 0.95 0.95 0.90 0.95 0.90 0.95 0.95 0.90 0.95
## [466] 0.75 1.00 0.95 0.90 0.95 0.90 0.90 0.95 0.90 0.90 1.00 0.75 0.90 1.00 0.85
## [481] 0.95 0.85 0.95 0.75 0.85 0.90 0.90 1.00 1.00 0.95 0.90 0.90 1.00 0.95 0.95
## [496] 0.95 0.75 0.90 0.85 1.00
### Histograma para visualizar el comportamiento de los rho en cada muestra

par(mfrow = c(1, 2))

hist(mediax,probability=T,main="Histograma de los rho",xlab="") 
lines = plot(density(mediax), type = "l", col="red", main="Densidad de los valor de rho",xlab="")

En el histograma de los valores de \(\widehat{\rho}\) se observa que con un tamaño de muestra de \(n=500\), estos comienzan a tener una forma de campana inclinada hacia la derecha, lo cual se valida en la gráfica de densidad de los datos.

Por otro lado, al revisar los valores de la media y la varianza se observa que el primero se acerca al valor de \(\rho\) y el segundo es un valor muy bajo.

### Estimación Parámetros según el TLC ###
mean(mediax) #valor esperado de la media muestral
## [1] 0.9134
var(mediax) #varianza de la media muestral
## [1] 0.004208858
sd(mediax) #error estándar de la media muestral
## [1] 0.06487571

0.3.5.10 Paso d

n<-20 # tamaño de las muestras a seleccionar
k<-5 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_5 <- shapiro.test(mediax)
a_5 <- mediax

#--------------

k<-10 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_10 <- shapiro.test(mediax)
a_10 <- mediax

#--------------

k<-15 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_15 <- shapiro.test(mediax)
a_15 <- mediax

#--------------

k<-20 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_20 <- shapiro.test(mediax)
a_20 <- mediax

#--------------

k<-30 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_30 <- shapiro.test(mediax)
a_30 <- mediax

#--------------
k<-50 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_50 <- shapiro.test(mediax)
a_50 <- mediax

#--------------

k<-60 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_60 <- shapiro.test(mediax)
a_60 <- mediax

#--------------

k<-100 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_100 <- shapiro.test(mediax)
a_100 <- mediax

#--------------

k<-200 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_200 <- shapiro.test(mediax)
a_200 <- mediax

#--------------

k<-500 # cantidad de muestras
mat<-matrix(,nrow=k,ncol=n) #matriz para almacenar k muestras de tamaño n simuladas
mediax<-vector() #vector para almacenar el promedio de las k muestras

for (i in 1:k)
{
  x<-sample(poblacion,n,replace = FALSE, prob = NULL)
  mat[i,]<-x
  mediax[i]<-mean(x)
  resultado <- list(rho_hat=mediax)
}

x.test_500 <- shapiro.test(mediax)
a_500 <- mediax

#--------------

x.test_5
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.82083, p-value = 0.1185
x.test_10
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.79138, p-value = 0.01139
x.test_15
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.88039, p-value = 0.04808
x.test_20
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.85805, p-value = 0.007294
x.test_30
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.92133, p-value = 0.02905
x.test_50
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.90937, p-value = 0.0009947
x.test_60
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.92103, p-value = 0.0008443
x.test_100
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.91325, p-value = 6.283e-06
x.test_200
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.9087, p-value = 9.336e-10
x.test_500
## 
##  Shapiro-Wilk normality test
## 
## data:  mediax
## W = 0.91238, p-value < 2.2e-16

De acuerdo con la prueba Shapiro-Wilk tenemos que:

\(H_0=\) La distribución es normal \(H_1=\) La distribución no es normal

Con base en lo anterior, los resultados de la prueba para las diferentes tamaños de muestra indican que, a medida que el tamaño de muestra aumenta el \(p-value\) disminuye y por tanto se rechaza la hipotesis nula. En este escenario, esto ocurre con valores de \(n>10\).

Por otro lado, la función \(qqnorm\) genera un gráfico \(Q-Q\) que compara los cuantiles de los datos con los cuantiles teóricos de la distribución normal estándar, N(0, 1).

La función \(qqline\) superpone una línea que nos ayuda a evaluar la relación lineal de las dos distribuciones. Esta línea, que por defecto cruza los puntos del primer (0,25) y el tercer cuartil (0,75), es una aproximación robusta de los valores esperados de nuestros datos si siguieran una distribución normal estándar. Si los datos se alejan de esta línea, especialmente cerca del centro, nos sugeriría que nuestros datos no se distribuyen normalmente.

par(mfrow = c(1, 2))


par(mfrow = c(2, 5))

qqnorm(a_5,main="qqnorm n=5",xlab="")
qqline(a_5, col ="red")
qqnorm(a_10,main="qqnorm n=10",xlab="")
qqline(a_10, col ="red")
qqnorm(a_15,main="qqnorm n=15",xlab="")
qqline(a_15, col ="red")
qqnorm(a_20,main="qqnorm n=20",xlab="")
qqline(a_20, col ="red")
qqnorm(a_30,main="qqnorm n=30",xlab="")
qqline(a_30, col ="red")
qqnorm(a_50,main="qqnorm n=50",xlab="")
qqline(a_50, col ="red")
qqnorm(a_60,main="qqnorm n=60",xlab="")
qqline(a_60, col ="red")
qqnorm(a_100,main="qqnorm n=100",xlab="")
qqline(a_100, col ="red")
qqnorm(a_200,main="qqnorm n=200",xlab="")
qqline(a_200, col ="red")
qqnorm(a_500,main="qqnorm n=500",xlab="")
qqline(a_500, col ="red")

Los resultados gráficos muestran que con el aumento de la muestra se asocia con una mejor aproximación de normalidad en los datos.

0.4 Problema 4

Estimacción boostrap

Cuando se extrae una muestra de una población que no es normal y se requiere estimar un intervalo de confianza se pueden utilizar los métodos de estimación bootstrap. Esta metodología supone que se puede reconstruir la población objeto de estudio mediante un muestreo con reemplazo de la muestra que se tiene. Existen varias versiones del método. Una presentación básica del método se describe a continuación:

El artículo de In-use Emissions from Heavy Duty Dissel Vehicles (J.Yanowitz, 2001) presenta las mediciones de eficiencia de combustible en millas/galón de una muestra de siete camiones. Los datos obtenidos son los siguientes: 7.69, 4.97, 4.56, 6.49, 4.34, 6.24 y 4.45. Se supone que es una muestra aleatoria de camiones y que se desea construir un intervalo de confianza del \(95 %\) para la media de la eficiencia de combustible de esta población. No se tiene información de la distribución de los datos. El método bootstrap permite construir intervalos de confianza del \(95 %\) - Para ilustrar el método suponga que coloca los valores de la muestra en una caja y extrae uno al azar. Este correspondería al primer valor de la muestra bootstrap \(X_1^{*}\). Después de anotado el valor se regresa \(X_1^{*}\) a la caja y se extrae el valor \(X_2^{*}\), regresandolo nuevamente. Este procedimiento se repite hasta completar una muestra de tamaño \(n, X_1^{*}, X_2^{*}, X_3^{*}, X_n^{*}\), conformando la muestra bootstrap.

Es necesario extraer un gran número de muestras (suponga \(k = 1000\)). Para cada una de las muestra bootstrap obtenidas se calcula la media \(\overline{X_i^{*}}\), obteniéndose un valor para cada muestra. El intervalo de confianza queda conformado por los percentiles \(P_2.5 y P_97.5\). Existen dos métodos para estimarlo:

Método 1: \((P_2.5;P_97.5)\)

Método 2: \(2\overline{X}-(P_97.5);2\overline{X}-(P_2.5)\)

Construya el intervalo de confianza por los dos métodos y compare los resultados obtenidos. Comente los resultados. Confiaría en estas estimaciones?

#Ejercicio extraído del artículo de In-use Emissions from Heavy Duty Dissel Vehicles (J.Yanowitz, 2001)
#Navidi(2006)

x=c( 7.69, 4.97, 4.56, 6.49, 4.34, 6.24, 4.45) # datos muestra
boot=sample(x,70000,replace=TRUE)   # se extraen n x m muestras
b=matrix(boot,nrow=10000,ncol=7)    # se construye matriz de n x m 
mx=apply(b,1,mean)                 # se calculan m medias por fila

ic1=quantile(mx, probs=c(0.025, 0.975)) # se calcula IC método 1
ic1
##     2.5%    97.5% 
## 4.717107 6.454286
ic2=c(2*mean(mx)-ic1[2], 2*mean(mx)-ic1[1]) # se calcula IC método 2
ic2
##    97.5%     2.5% 
## 4.619518 6.356697
hist(mx, las=1, main=" ", ylab = " ", xlab = " ", col="grey")
abline(v=ic1, col="red",lwd=2)
abline(v=ic2, col="blue",lwd=2)

Los dos métodos para el cálculo de intervalos de confianza son muy similares. De acuerdo con Navidi (2006), la colección de las medias muestrales de estimación bootstrap \(\overline{X_i^{*}}\) se aproxima a una muestra aleatoria de la distribución de \(\overline{X}\), por lo que esta colección, en vez de la curva normal, constituye la base para el intervalo de confianza. El ancho del intervalo de confianza de estimación bootstrap es puesto para igualar el ancho de \(95\%\) intermedio de la media muestral de estimación bootstrap con el fin de aproximar el ancho de la distribución desconocida de \(\overline{X}\).

Así las cosas, los resultados de las dos formas de estimar intervalos de confianza se podrían ver como estrategias complementarias, dado que la segunda corrige el intervalo y/o sesgo de la primera.

El desarrollo de este punto se hizo con base en los apuntes de clase.