Actividad 2

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:

PROBLEMA 1

Estimación del valor de π

La siguiente figura sugiere como estimar el valor de π con una simulación. En la figura, un circuito con un área igual a π/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 π/4. Por tanto, se puede estimar el valor de π/4 al contar el número de puntos dentro del círculo, para obtener la estimación de π/4. De este último resultado se encontrar una aproximación para el valor de π.

Pasos sugeridos:

Genere n coordenadas x: X1, . . . , Xn. 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).

n<-1000
x<-runif(n)
head(x)

## [1] 0.5766586 0.8569647 0.9366279 0.4406046 0.5792992 0.4356586

Genere 1000 coordenadas y: Y1,…,Yn, utilizando nuevamente la distribución uniforme con valor mínimo de 0 y valor máximo de 1.

y<-runif(n)
head(y)

## [1] 0.62377699 0.71927074 0.05403339 0.01383821 0.20934891 0.60080660

Resultados:

Se crea los números aleatorios para las variables X y Y para n coordenadas con la función runif().

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

#Creación del data-frame con los puntos Xi y Yi
xy<-data.frame(x,y) 
summarytools::descr(xy)

## Descriptive Statistics  
## xy  
## N: 1000  
## 
##                           x         y
## ----------------- --------- ---------
##              Mean      0.51      0.50
##           Std.Dev      0.28      0.28
##               Min      0.00      0.00
##                Q1      0.28      0.27
##            Median      0.51      0.49
##                Q3      0.76      0.73
##               Max      1.00      1.00
##               MAD      0.36      0.34
##               IQR      0.48      0.46
##                CV      0.55      0.55
##          Skewness     -0.02      0.02
##       SE.Skewness      0.08      0.08
##          Kurtosis     -1.15     -1.14
##           N.Valid   1000.00   1000.00
##         Pct.Valid    100.00    100.00

#Cración de la Función Fx
fx<-function(x,y){sqrt((x-0.5)^2+(y-0.5)^2)} 

#function mpply, matriz y por se filas multiplica
Distancia<-mapply(fx,xy$x,xy$y) 
head(Distancia)

## [1] 0.1455929 0.4189314 0.6241235 0.4897766 0.3012747 0.1195901

#Condición: Identificar puntos mayores al radio. 
puntos<-as.numeric(Distancia>0.5) 
head(puntos)

## [1] 0 0 1 0 0 0

Resultados:

La Mean de los puntos Xi (0.49) y Yi (0.50) para 1.000, en la función fx se coloca la Raíz cuadrada para evitar los números negativos. En la creación de la Distancia<-apply(xy, 1, fx) - se verifica la función apply pero se cambia por mapply para generar los resultados, ya que no funciono.

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

#Número de puntos por fuera del Circulo 
sum(puntos)

## [1] 178

#numero de puntos dentro del circulo: sumamos cuantos valores de puntos son iguales a 1 menos n.
n-sum(puntos)

## [1] 822

#Area Cuadrado = Lado x Lado y Area del Circulo = Pi*r2 y del Perimetro = 2*Pi*r
pi/4

## [1] 0.7853982

pi*0.5^2

## [1] 0.7853982

1-pi*0.5^2

## [1] 0.2146018

#Finalmente para la aproximación de Pi
Aproxπ<-(sum(puntos)/n)*4
Aproxπ

## [1] 0.712

#Gráfica
rad     <- 0.5   # Valor del radio
xcenter <- 0.5  # Coordenada en x del centro
ycenter <- 0.5   # Coordenada en y del centro
plot(c(0, 1), c(0, 1), type="n", xlab="x", ylab="y", asp=1)
theta <- seq(0, 2 * pi, length = 200)
polygon(x=rad * cos(theta) + xcenter,
        y=rad * sin(theta) + ycenter,
        lwd=3, col='#DA3E2F', border='#9C0824')
points(x,y,pch = 1)

Conclusión:

Se Simulan valores grandes, para demostar que entre mayor el numero de n, mayor la aproximación a π: - Con 1.000 puntos: 216 estan por fuera y 784 por dentro, finalmente la aproxición a π con 1.000 puntos: 0.864 - Con 10.000 puntos: 2.111 estan por fuera y 7.889 por dentro, finalmente la aproxición a π con 10.000 puntos: 0.85124 - Con 100.000 puntos: 21.281 estan por fuera y 78.719 por dentro, finalmente la aproxición a π con 10.000 puntos: 0.8444

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.

Sean X1, X2, X3 y X4, una muestra aleatoria de tamaño n=4 cuya población la conforma una distribución exponencial con parámetro θ desconocido. Determine las características de cada uno de los siguientes estimadores propuestos:

Muestra aleatoria de tamaño n=4

#X1, X2, X3 y X4, una muestra aleatoria de tamaño n=4
x1<-rexp(4,1)
x2<-rexp(4,1)
x3<-rexp(4,1)
x4<-rexp(4,1)
Base<-data.frame(x1,x2,x3,x4)

#Se determina las características de cada uno de los siguientes estimadores propuestos
fx1<-function(x1,x2,x3,x4){(x1+x2)/6+(x3+x4)/3}
fx2<-function(x1,x2,x3,x4){(x1+2*x2+3*x3+4*x4)/5}
fx3<-function(x1,x2,x3,x4){(x1+x2+x3+x4)/4}
fx4<-function(x1,x2,x3,x4){(min(x1,x2,x3,x4)+max(x1,x2,x3,x4))/2}

#Aplicación de la muestra aleatoria a cada función 
T1<-mapply(fx1,Base$x1,Base$x2,Base$x3,Base$x4)
T2<-mapply(fx2,Base$x1,Base$x2,Base$x3,Base$x4)
T3<-mapply(fx3,Base$x1,Base$x2,Base$x3,Base$x4)
T4<-mapply(fx4,Base$x1,Base$x2,Base$x3,Base$x4)
w<-data.frame(T1,T2,T3,T4)

#Gráfica de Caja de cada θ
boxplot(w)
abline(h=1, col="red")

# 
#summary(w)
#var(w)

Resultados:

En la muestra de Tamaño 4, se observa T1 que es insesgado a diferencia de T4 que tiene un mayor sesgo. En el caso de T3 y T4 más cerca de 1 con menor varianza que T1.

Muestra aleatoria de tamaño n=20

#X1, X2, X3 y X4, una muestra aleatoria de tamaño n=20
x1<-rexp(20,1)
x2<-rexp(20,1)
x3<-rexp(20,1)
x4<-rexp(20,1)
Base<-data.frame(x1,x2,x3,x4)

#Se determina las características de cada uno de los siguientes estimadores propuestos
fx1<-function(x1,x2,x3,x4){(x1+x2)/6+(x3+x4)/3}
fx2<-function(x1,x2,x3,x4){(x1+2*x2+3*x3+4*x4)/5}
fx3<-function(x1,x2,x3,x4){(x1+x2+x3+x4)/4}
fx4<-function(x1,x2,x3,x4){(min(x1,x2,x3,x4)+max(x1,x2,x3,x4))/2}

#Aplicación de la muestra aleatoria a cada función 
T1<-mapply(fx1,Base$x1,Base$x2,Base$x3,Base$x4)
T2<-mapply(fx2,Base$x1,Base$x2,Base$x3,Base$x4)
T3<-mapply(fx3,Base$x1,Base$x2,Base$x3,Base$x4)
T4<-mapply(fx4,Base$x1,Base$x2,Base$x3,Base$x4)
w<-data.frame(T1,T2,T3,T4)

#Gráfica de Caja de cada θ
boxplot(w)
abline(h=1, col="red")

# 
#summary(w)
#var(w)

Resultados:

Se observa que con 20 muestras T1 se aleja de 1 pero T3 y T4 se acercan, con una media de 0.9637 y 1.0737 respectivamente, al igual que T2.

###Muestra aleatoria de tamaño n=50

#X1, X2, X3 y X4, una muestra aleatoria de tamaño n=50
x1<-rexp(50,1)
x2<-rexp(50,1)
x3<-rexp(50,1)
x4<-rexp(50,1)
Base<-data.frame(x1,x2,x3,x4)

#Se determina las características de cada uno de los siguientes estimadores propuestos
fx1<-function(x1,x2,x3,x4){(x1+x2)/6+(x3+x4)/3}
fx2<-function(x1,x2,x3,x4){(x1+2*x2+3*x3+4*x4)/5}
fx3<-function(x1,x2,x3,x4){(x1+x2+x3+x4)/4}
fx4<-function(x1,x2,x3,x4){(min(x1,x2,x3,x4)+max(x1,x2,x3,x4))/2}

#Aplicación de la muestra aleatoria a cada función 
T1<-mapply(fx1,Base$x1,Base$x2,Base$x3,Base$x4)
T2<-mapply(fx2,Base$x1,Base$x2,Base$x3,Base$x4)
T3<-mapply(fx3,Base$x1,Base$x2,Base$x3,Base$x4)
T4<-mapply(fx4,Base$x1,Base$x2,Base$x3,Base$x4)
w<-data.frame(T1,T2,T3,T4)

#Gráfica de Caja de cada θ
boxplot(w)
abline(h=1, col="red")

# 
#summary(w)
#var(w)

Resultados:

En el suguiente diagrama, se observa algo muy similar a la muestra n=20, acercandose levemente a 1 T3, T4 y T2.

###Muestra aleatoria de tamaño n=100

#X1, X2, X3 y X4, una muestra aleatoria de tamaño n=20
x1<-rexp(100,1)
x2<-rexp(100,1)
x3<-rexp(100,1)
x4<-rexp(100,1)
Base<-data.frame(x1,x2,x3,x4)

#Se determina las características de cada uno de los siguientes estimadores propuestos
fx1<-function(x1,x2,x3,x4){(x1+x2)/6+(x3+x4)/3}
fx2<-function(x1,x2,x3,x4){(x1+2*x2+3*x3+4*x4)/5}
fx3<-function(x1,x2,x3,x4){(x1+x2+x3+x4)/4}
fx4<-function(x1,x2,x3,x4){(min(x1,x2,x3,x4)+max(x1,x2,x3,x4))/2}

#Aplicación de la muestra aleatoria a cada función 
T1<-mapply(fx1,Base$x1,Base$x2,Base$x3,Base$x4)
T2<-mapply(fx2,Base$x1,Base$x2,Base$x3,Base$x4)
T3<-mapply(fx3,Base$x1,Base$x2,Base$x3,Base$x4)
T4<-mapply(fx4,Base$x1,Base$x2,Base$x3,Base$x4)
w<-data.frame(T1,T2,T3,T4)

#Gráfica de Caja de cada θ
boxplot(w)
abline(h=1, col="red")

# 
#summary(w)
#var(w)

Resultados:

Con n=100 la cercania con 1, mejoro para T1 y T3, con una media de 0.9304 y 0.9503, pero aparecen mayores puntos atipicos.

###Muestra aleatoria de tamaño n=1000

#X1, X2, X3 y X4, una muestra aleatoria de tamaño n=1000
x1<-rexp(1000,1)
x2<-rexp(1000,1)
x3<-rexp(1000,1)
x4<-rexp(1000,1)
Base<-data.frame(x1,x2,x3,x4)

#Se determina las características de cada uno de los siguientes estimadores propuestos
fx1<-function(x1,x2,x3,x4){(x1+x2)/6+(x3+x4)/3}
fx2<-function(x1,x2,x3,x4){(x1+2*x2+3*x3+4*x4)/5}
fx3<-function(x1,x2,x3,x4){(x1+x2+x3+x4)/4}
fx4<-function(x1,x2,x3,x4){(min(x1,x2,x3,x4)+max(x1,x2,x3,x4))/2}

#Aplicación de la muestra aleatoria a cada función 
T1<-mapply(fx1,Base$x1,Base$x2,Base$x3,Base$x4)
T2<-mapply(fx2,Base$x1,Base$x2,Base$x3,Base$x4)
T3<-mapply(fx3,Base$x1,Base$x2,Base$x3,Base$x4)
T4<-mapply(fx4,Base$x1,Base$x2,Base$x3,Base$x4)
w<-data.frame(T1,T2,T3,T4)

#Gráfica de Caja de cada θ
boxplot(w)
abline(h=1, col="red")

# 
#summary(w)
#var(w)

Resultados:

Con n=1.000, se observan T1, T3, y T4 cercanos a 1, con mayor insesgades, consistentes y eficacia pero, todos con un mayor números de puntos atipicos.

Conclusión:

Se utiliza la simulacion como herramienta para validar propiedades de los estimadores, cambiando la muestra, graficado en un diagrama de cajas, calculando la media para ver cual se acerca más.Se observa que al aumentar la muestra aleatoria de tamaño n, la mayoria de los θ son más insesgados pero con mayor varianza y con mayor puntos o valores atipicos. Lo que se puede decir es que θ 4 es el más eficiente.

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.

Objetivo: Utilizar la simulación para validar un teorema

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

n<-1000 # Población
Pe<-0.5 # Porcentaje de Plantas Enfermas

P<-rbinom(n = n, size = 1, prob = Pe)
head(P)

## [1] 1 0 0 1 0 1

Genere una función que permita:

Obtener una muestra aleatoria de la población y
Calcule el estimador de la proporción muestral pˆ para un tamaño de muestra dado n.

#Función de Muestra Aletoria y Estimador de Proporción.
MP<-function(P, m, n){MA<-sample(P,m, replace=FALSE) 
R<-sum(MA==1)/m
return(R)} 

MP

## function(P, m, n){MA<-sample(P,m, replace=FALSE) 
## R<-sum(MA==1)/m
## return(R)}

#Muestra Aleatoria
# Calculo de pˆ

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

m<-500 #Muestra
Estimaciones500<- numeric()

for(i in 1:m){
      Muestra500<-MP(P,m,n)
      Estimaciones500[i]<-mean(Muestra500)
}

hist(Estimaciones500,density=20)

#summary(Estimaciones500)

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

m<-20 #Muestras
Estimaciones5<- numeric()
Estimaciones10<- numeric()
Estimaciones20<- numeric()
Estimaciones30<- numeric()
Estimaciones50<- numeric()
Estimaciones60<- numeric()
Estimaciones100<- numeric()
Estimaciones200<- numeric()
Estimaciones500<- numeric()

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones5[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones10[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones20[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones30[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones50[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones60[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones100[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones200[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      Estimaciones500[i]<-mean(Muestra)
}

par(mfrow=c(3,3))
hist(Estimaciones5,density=20)
hist(Estimaciones10,density=20)
hist(Estimaciones20,density=20)
hist(Estimaciones30,density=20)
hist(Estimaciones50,density=20)
hist(Estimaciones60,density=20)
hist(Estimaciones100,density=20)
hist(Estimaciones200,density=20)
hist(Estimaciones500,density=20)

Gráfica

par(mfrow=c(3,3))
qqnorm(Estimaciones5, main="n=5") ; qqline(Estimaciones5, col="red")
qqnorm(Estimaciones10, main="n=10") ; qqline(Estimaciones10, col="red")
qqnorm(Estimaciones20, main="n=20") ; qqline(Estimaciones20, col="red")
qqnorm(Estimaciones30, main="n=30") ; qqline(Estimaciones30, col="red")
qqnorm(Estimaciones50, main="n=50") ; qqline(Estimaciones50, col="red")
qqnorm(Estimaciones60, main="n=60") ; qqline(Estimaciones60, col="red")
qqnorm(Estimaciones100, main="n=100") ; qqline(Estimaciones100, col="red")
qqnorm(Estimaciones200, main="n=200") ; qqline(Estimaciones200, col="red")
qqnorm(Estimaciones500, main="n=500") ; qqline(Estimaciones500, col="red")

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.

#Lotes con 10% de plantas enfermas
n<-1000 # Población
Pe<-0.1 # Porcentaje de Plantas Enfermas 10%
P<-rbinom(n = n, size = 1, prob = Pe)

MP<-function(P, m, n){MA<-sample(P,m, replace=FALSE) 
R<-sum(MA==1)/m
return(R)} 

m<-500 # Muestra
P10_5<- numeric()
P10_10<- numeric()
P10_20<- numeric()
P10_30<- numeric()
P10_50<- numeric()
P10_60<- numeric()
P10_100<- numeric()
P10_200<- numeric()
P10_500<- numeric()

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_5[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_10[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_20[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_30[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_50[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_60[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_100[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_200[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P10_500[i]<-mean(Muestra)
}

par(mfrow=c(3,3))
hist(P10_5,density=20)
hist(P10_10,density=20)
hist(P10_20,density=20)
hist(P10_30,density=20)
hist(P10_50,density=20)
hist(P10_60,density=20)
hist(P10_100,density=20)
hist(P10_200,density=20)
hist(P10_500,density=20)

Gráfico Q-Q

par(mfrow=c(3,3))
qqnorm(P10_5, main="n=5") ; qqline(P10_5, col="red")
qqnorm(P10_10, main="n=10") ; qqline(P10_10, col="red")
qqnorm(P10_20, main="n=20") ; qqline(P10_20, col="red")
qqnorm(P10_30, main="n=30") ; qqline(P10_30, col="red")
qqnorm(P10_50, main="n=50") ; qqline(P10_50, col="red")
qqnorm(P10_60, main="n=60") ; qqline(P10_60, col="red")
qqnorm(P10_100, main="n=100") ; qqline(P10_100, col="red")
qqnorm(P10_200, main="n=200") ; qqline(P10_200, col="red")
qqnorm(P10_500, main="n=500") ; qqline(P10_500, col="red")

Lotes con 90% de plantas enfermas

n<-1000 # Población
Pe<-0.9 # Porcentaje de Plantas Enfermas 90%
P<-rbinom(n = n, size = 1, prob = Pe)

MP<-function(P, m, n){MA<-sample(P,m, replace=FALSE) 
R<-sum(MA==1)/m
return(R)} 

m<-500 # Muestra
P90_5<- numeric()
P90_10<- numeric()
P90_20<- numeric()
P90_30<- numeric()
P90_50<- numeric()
P90_60<- numeric()
P90_100<- numeric()
P90_200<- numeric()
P90_500<- numeric()

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_5[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_10[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_20[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_30[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_50[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_60[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_100[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_200[i]<-mean(Muestra)
}

for(i in 1:m){
      Muestra<-MP(P,m,n)
      P90_500[i]<-mean(Muestra)
}

par(mfrow=c(3,3))
hist(P90_5,density=20)
hist(P90_10,density=20)
hist(P90_20,density=20)
hist(P90_30,density=20)
hist(P90_50,density=20)
hist(P90_60,density=20)
hist(P90_100,density=20)
hist(P90_200,density=20)
hist(P90_500,density=20)

gráfico Q-Q

par(mfrow=c(3,3))
qqnorm(P90_5, main="n=5") ; qqline(P90_5, col="red")
qqnorm(P90_10, main="n=10") ; qqline(P90_10, col="red")
qqnorm(P90_20, main="n=20") ; qqline(P90_20, col="red")
qqnorm(P90_30, main="n=30") ; qqline(P90_30, col="red")
qqnorm(P90_50, main="n=50") ; qqline(P90_50, col="red")
qqnorm(P90_60, main="n=60") ; qqline(P90_60, col="red")
qqnorm(P90_100, main="n=100") ; qqline(P90_100, col="red")
qqnorm(P90_200, main="n=200") ; qqline(P90_200, col="red")
qqnorm(P90_500, main="n=500") ; qqline(P90_500, col="red")

Conclusión:

En el Calculo de estimador de la proporción muestral se ve el tamaño de la muestra n y X que es el número de aciertos encontrados en esa muestra, en p^ corresponde al número de plantas en la muestra con esa enfermedad dividido n, n que corresponde al numero de la muestra.

Claramente se observa la transporfación al aumentar la muestra, en que momento pasa de ser asimetrica a simetrica en n=200, se callculo la media segun teorema para evidenciar el resultado y con anterioridad se hizo la función estimador de proporción (tamaño del muestra).

Finalmente en la función qqnorm se ve que genera un gráfico Q-Q que compara los cuantiles de nuestros datos (sample quantiles) con los cuantiles teóricos (theoretical quantiles) de la distribución normal estándar, N(0, 1), demostrando lo anterior.

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∗2,X∗n, conformando la muestra bootstrap.

Es necesario extraer un gran número de muestras (suponga k = 1000). Para cada una de las muestras bootstrap obtenidas se calcula la media X∗i¯, obteniéndose un valor para cada muestra. El intervalo de confianza queda conformado por los percentiles P2.5 y P97.5. Existen dos métodos para estimarlo:

Método 1: (P2.5;P97.5) Método 2: (2X¯−P97.5;2X¯−P2.5)

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

#Muestras
x<-c(7.69, 4.97, 4.56, 6.49, 4.34, 6.24, 4.45)

#Extracción de Muestras de Tamaño 7.000
m<-sample(x,7000, replace = TRUE) 
#Matrix
m7<-matrix(m, nrow=1000, ncol = 7)
# Médias
mx<-apply(m7, 1, mean)

# Calculo IC Método 1
ic1=quantile(mx, probs=c(0.025, 0.975)) 
ic1

##     2.5%    97.5% 
## 4.709893 6.450107

#Calculo IC Método 2
ic2=c(2*mean(mx)-ic1[2], 2*mean(mx)-ic1[1]) 
ic2

##    97.5%     2.5% 
## 4.598859 6.339073

#Histograma
hist(mx, las=1, main=" ", ylab = " ", xlab = " ", col="#FFB900")
abline(v=ic1, col="#26456E",lwd=2)
abline(v=ic2, col="#24693D",lwd=2)

Conclusión:

En el problema anterior se utilizan muestras aleatorias de una población finita, pequeña con remplazo para calcular medías por filas, y calcular los Percentiles 5 y 95 en el método 1: (P2.5;P97.5) y así Utilizar los percentiles para encontrar un intervalo de confianza, y en el método 2 (2X¯−P97.5;2X¯−P2.5) se corrige el intervalo.

Estas estimaciones se emplean y garantizan un calculo en los intervalos de confianza, en la evaluación para un determinado tamaño de muestra en un proceso de remuestreo, y así equilibrar muestras.

Actividad 2

John Díaz Alonso

2023-09-13