Problema 1

Se realizó el cálculo del valor de pi a través calcular el número de puntos que caen al interior de un circulo enmarcado dentro de un cuadrado, se hicieron dos cálculos distintos uno con una simulación de 1000 datos:

set.seed(123456)
n=1000

puntosX <- runif(n, min=0, max=1)
puntosY <- runif(n, min=0, max=1)

funcionCentro <- function(x,y){

i<- (((x-0.5) ^ 2)+((y-0.5) ^ 2))
ifelse(i <= 0.25, 1, 0)

}

sum(funcionCentro(puntosX,puntosY))
## [1] 807
estimado <- sum(funcionCentro(puntosX,puntosY)) 

pi <- (estimado/n)*4; pi
## [1] 3.228

Y otro con una simulación de 100000 datos:

set.seed(123456)
puntosX <- runif(100000, min=0, max=1)
puntosY <- runif(100000, min=0, max=1)

funcionCentro <- function(x,y){

i<- (((x-0.5) ^ 2)+((y-0.5) ^ 2))
  
ifelse(i <= 0.25, 1, 0)
}

sum(funcionCentro(puntosX,puntosY))
## [1] 78600
estimado <- sum(funcionCentro(puntosX,puntosY)) 

pi <- (estimado/100000)*4; pi
## [1] 3.144

A medida que el valor n del tamaño de muestra aumenta, el valor estimado de pi se va acercando más a su valor real, ganando más decimales correctos. Esto demuestra la importancia del valor muestreal y que a pesar de usar solamente 1000 datos en la primera simulación, da un valor útil a la realidad.

Problema 2

Se realizó el cálculo para los cuatro indicadores con diferentes tamaños de muestra y presentan comportamientos muy similares con al usar los distintos tamaños de muestra, como se ve a continuación:

set.seed(123)
lambda=2

# Funcion para correr una logaritmica con vrate=lambda y devolver 4 valores para lambda 1 a 4
parametrosTeta <- function(lambda){
  logaritmica <- rexp(4,lambda)
  x1<- logaritmica[1]
  x2<- logaritmica[2]
  x3<- logaritmica[3]
  x4<- logaritmica[4]
  teta1<- ((x1+x2)/6) + ((x3+x4)/3)
  teta2<- (x1+2*x2+3*x3+4*x4)/5
  teta3<- (x1+x2+x3+x4)/4
  teta4<- (min(c(x1,x2,x3,x4))+max(c(x1,x2,x3,x4)))/2
    
  tetas <- c(teta1, teta2, teta3, teta4)
  return(tetas)
}

# muestra
muestra = 20
# correr 20 veces las funciones
vectorprueba<- replicate(muestra, parametrosTeta(lambda))

# para teta 

  boxplot(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,],main = "Simulación con n = 20", names=c("Teta1", "Teta2", "Teta3", "Teta4"), xlab = "Estimadores", ylab = "Valores", col = c("yellow","blue","green","orange"))
  abline(h=1/lambda,  col="red") 

  # estimadores 
  media = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, mean)
  desviacion = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, sd)
  varianza = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, var)
  sesgo <- lambda - media 
  
  valores <- data.frame(media,desviacion, varianza, sesgo)
  prop.table(valores)
##                        media desviacion    varianza     sesgo
## vectorprueba.1... 0.04975637 0.02281288 0.005143753 0.1525968
## vectorprueba.2... 0.10004777 0.05085484 0.025561388 0.1023054
## vectorprueba.3... 0.05145482 0.02503112 0.006192707 0.1508984
## vectorprueba.4... 0.06133229 0.03953900 0.015451519 0.1410209
# muestra
muestra = 50
# correr 50 veces las funciones
vectorprueba<- replicate(muestra, parametrosTeta(lambda))

# hist(vectorprueba500)

# para teta 

  boxplot(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,],main = "Simulación con n = 50",  names=c("Teta1", "Teta2", "Teta3", "Teta4"), xlab = "Estimadores", ylab = "Valores", col = c("yellow","blue","green","orange"))
  abline(h=1/lambda,  col="red") 

# estimadores 
 
  media = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, mean)
 desviacion = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, sd)
 varianza = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, var)
  sesgo <- lambda - media 
  
  valores <- data.frame(media,desviacion, varianza, sesgo)
  prop.table(valores)
##                        media desviacion    varianza     sesgo
## vectorprueba.1... 0.05399172 0.02285881 0.004942382 0.1574550
## vectorprueba.2... 0.10964978 0.04745894 0.021304195 0.1017969
## vectorprueba.3... 0.05399782 0.02073742 0.004067603 0.1574489
## vectorprueba.4... 0.06006412 0.02630097 0.006542936 0.1513826
# muestra
muestra = 100
# correr 100 veces las funciones
vectorprueba<- replicate(muestra, parametrosTeta(lambda))

# para teta 
boxplot(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,],main = "Simulación con n = 100",  names=c("Teta1", "Teta2", "Teta3", "Teta4"), xlab = "Estimadores", ylab = "Valores", col = c("yellow","blue","green","orange"))
  abline(h=1/lambda,  col="red") 

    # estimadores 
  #cat("Valores de las medias \n")
  media = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, mean)
  #cat("\n Valores de la desviaciones estandar \n ")
  desviacion = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, sd)
  #cat("\n Valores de la varianza \n ")
  varianza = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, var)
  sesgo <- lambda - media 
  
  valores <- data.frame(media,desviacion, varianza, sesgo)
  prop.table(valores)
##                        media desviacion    varianza     sesgo
## vectorprueba.1... 0.05052131 0.02403761 0.005604942 0.1556563
## vectorprueba.2... 0.10111859 0.05119955 0.025428502 0.1050591
## vectorprueba.3... 0.05136245 0.02352340 0.005367705 0.1548152
## vectorprueba.4... 0.06103775 0.03087853 0.009249146 0.1451399
  # muestra
muestra = 1000
# correr 1000 veces las funciones
vectorprueba<- replicate(muestra, parametrosTeta(lambda))

# para teta 
  boxplot(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,],main = "Simulación con n = 1000",  names=c("Teta1", "Teta2", "Teta3", "Teta4"), xlab = "Estimadores", ylab = "Valores", col = c("yellow","blue","green","orange"))
  abline(h=1/lambda,  col="red") 

  # estimadores 
  media = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, mean)
  desviacion = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, sd)
 varianza = apply(data.frame(vectorprueba[1,],vectorprueba[2,],vectorprueba[3,],vectorprueba[4,]),2, var)
  sesgo <- lambda - media 
  
  valores <- data.frame(media,desviacion, varianza, sesgo)
  prop.table(valores)
##                        media desviacion    varianza      sesgo
## vectorprueba.1... 0.05048150 0.02738285 0.007488487 0.14977808
## vectorprueba.2... 0.10128148 0.05711492 0.032578860 0.09897809
## vectorprueba.3... 0.05031788 0.02505413 0.006268956 0.14994170
## vectorprueba.4... 0.05902155 0.03251496 0.010558520 0.14123803

Estos estimadores no son consistentes, dado que a medida que aumenta el tamaño de la muestra, comienzan a mostrar valores atípicos extremos, no se alejan mucho del valor real pero no convergen.

Los estimadores teta 1 y teta 3, son los que tienen un menor sesgo y siempre están cerca del valor real del parámetro. Teta 4 tiende a disminuir el sesgo con un tamaño mayor de muestra y teta 2 siempre presenta un valor mayor al del parámetro, independientemente del tamaño de muestra.

Para la eficiencia, el mejor estimador es teta 3, que a lo largo de los distintos tamaños de muestra siempre tiene una de las menores varianzas, aunque teta 1 tienen una varianza muy similar pero ligeramente mayor. Teta 2 tiene la mayor varianza en todos los casos seguido de teta 4.

Como conclusión general, el mejor estimador es teta 3, que tienen menos sesgo, menos varianza y es más eficiente.

Problema 3

Se realizó el cálculo para los diferentes tamaños de muestra en la poblicación con 50% de individuos enfermos, como se ve a continuación:

Tamaño de muestra 5

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 5
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.92161, p-value = 1.834e-15

Tamaño de muestra 10

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 10
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.95776, p-value = 8.881e-11

Tamaño de muestra 15

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 15
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.97365, p-value = 7.815e-08

Tamaño de muestra 20

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 20
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.97871, p-value = 1.109e-06

Tamaño de muestra 30

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 30
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.98549, p-value = 6.92e-05

Tamaño de muestra 50

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 50
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.9854, p-value = 6.524e-05

Tamaño de muestra 60

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 60
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.99125, p-value = 0.004718

Tamaño de muestra 100

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 100
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.99244, p-value = 0.01244

Tamaño de muestra 200

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 200
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.99543, p-value = 0.1511

Tamaño de muestra 500

tamanoLote <- 1000
porcentaje <- 0.5
tamanoMuestra <- 500
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

hist(vectorprueba500, col = "lightblue")

boxplot(vectorprueba500)

qqnorm(vectorprueba500)

shapiro.test(vectorprueba500)
## 
##  Shapiro-Wilk normality test
## 
## data:  vectorprueba500
## W = 0.99636, p-value = 0.3141

Los resultados casi siempre son simétricos, aunque las muestras menores de 20 pueden llegar a tener distribuciones sesgadas a un lado. A partir de 60 las muestras siempre dan un valor simétrico.

La variabilidad es bastante grande para las muestras con un n a 100, con muestras que pueden llegar a de 0.3 a 0.7, a partir de 100 la variabilidad disminuye de forma considerable y los datos se comienzan a agrupar de forma consistente.

Para la prueba de normalidad, solamente los datos con un n mayor a 200 dan un valor p mayor a 0.05 para a aceptar la hipótesis nula de normalidad.

Histogramas de frecuencia para diferentes tamaños de muestra para población al 90%

Para una población con un 90% de enfermedad, las muestras con menos de 100 tiene un sesgo importante a la izquierda, que solamente se comienza a perder con unas muestras de 100 o más:

tamanoLote <- 1000
porcentaje <- 0.9
tamanoMuestra <- 5
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba90_5<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))
tamanoMuestra <- 10

vectorprueba90_10<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))


tamanoMuestra <- 15


vectorprueba90_15<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 20
vectorprueba90_20<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 30

vectorprueba90_30<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))


tamanoMuestra <- 50

vectorprueba90_50<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 60
vectorprueba90_60<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 100

vectorprueba90_100<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 200
vectorprueba90_200<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 500

vectorprueba90_500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

par(cex=0.5, cex.axis=.5, cex.lab=.5, cex.main=.5, cex.sub=.5,  mfrow=c(3,3), mai = c(.3, .3, .3, .3))

hist(vectorprueba90_5, col = "lightblue")
hist(vectorprueba90_10, col = "lightblue")
hist(vectorprueba90_15, col = "lightblue")
hist(vectorprueba90_20, col = "lightblue")
hist(vectorprueba90_30, col = "lightblue")
hist(vectorprueba90_50, col = "lightblue")
hist(vectorprueba90_60, col = "lightblue")
hist(vectorprueba90_100, col = "lightblue")
hist(vectorprueba90_200, col = "lightblue")

Con respecto al test de normalidad, ninguna muestra cumple los criterios de normalidad 0.9889066, 7.7396172^{-4}, Shapiro-Wilk normality test, vectorprueba90_200, todas tienen un valor p menor a 0.05.

Histogramas de frecuencia para diferentes tamaños de muestra para población al 10%

Para una población con un 10% de enfermedad, las muestras con menos de 100 tiene un sesgo importante a la derecha, que solamente se comienza a perder con unas muestras de 100 o más:

tamanoLote <- 1000
porcentaje <- 0.1
tamanoMuestra <- 5
vectorUno<- rep(1, 1000*porcentaje)
vectorCero<- rep(0, ((1-porcentaje)*1000))
poblacionBinomial <- c(vectorUno,vectorCero)

muestraBinomial <- function(poblacionBinomial,tamanoMuestra){
  muestra<- sample(poblacionBinomial,tamanoMuestra)
  resultado <- sum(muestra/tamanoMuestra)
  return(resultado)
}


vectorprueba90_5<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))
tamanoMuestra <- 10

vectorprueba90_10<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))


tamanoMuestra <- 15


vectorprueba90_15<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 20
vectorprueba90_20<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 30

vectorprueba90_30<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))


tamanoMuestra <- 50

vectorprueba90_50<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 60
vectorprueba90_60<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 100

vectorprueba90_100<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 200
vectorprueba90_200<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

tamanoMuestra <- 500

vectorprueba90_500<- replicate(500, muestraBinomial(poblacionBinomial,tamanoMuestra))

par(cex=0.5, cex.axis=.5, cex.lab=.5, cex.main=.5, cex.sub=.5,  mfrow=c(3,3), mai = c(.3, .3, .3, .3))

hist(vectorprueba90_5, col = "lightblue")
hist(vectorprueba90_10, col = "lightblue")
hist(vectorprueba90_15, col = "lightblue")
hist(vectorprueba90_20, col = "lightblue")
hist(vectorprueba90_30, col = "lightblue")
hist(vectorprueba90_50, col = "lightblue")
hist(vectorprueba90_60, col = "lightblue")
hist(vectorprueba90_100, col = "lightblue")
hist(vectorprueba90_200, col = "lightblue")

Con respecto al test de normalidad, ninguna muestra cumple los criterios de normalidad 0.9903483, 0.0023208, Shapiro-Wilk normality test, vectorprueba90_200, todas tienen un valor p menor a 0.05.

Problema 4

 datosCamion <- c(7.69, 4.97, 4.56, 6.49, 4.34, 6.24, 4.45)
  
  muestrasCamion<- function(datosCamion){
    muestra<- sample(datosCamion,5, replace = TRUE)  
    promedioMuestra<- mean(muestra)
    return(promedioMuestra)
  }
  
  # generar el vector de 1000 promedios de muestras
  vector1000Muestras<- replicate(1000, muestrasCamion(datosCamion))
  
  #metodo 1
  metodo1<- quantile(vector1000Muestras, probs = c(0.025,0.975)); metodo1
##   2.5%  97.5% 
## 4.5316 6.5840
  intervaloInferiorMetodo2<- 2*mean(vector1000Muestras)-metodo1[2]
  intervaloSuperiorMetodo2<- 2*mean(vector1000Muestras)-metodo1[1]
  
  metodo2<- c(intervaloInferiorMetodo2,intervaloSuperiorMetodo2); metodo2
##   97.5%    2.5% 
## 4.47668 6.52908
  #Histograma  con intervalos de confianza
  
  hist(vector1000Muestras, las = 1, main = "Estimación Boostrap", xlab = "Media", ylab = "Frecuencia", col = "lightblue")
  
  abline(v = metodo1, col = "green", lwd = 2, lty = 2)
  abline(v = metodo2, col = "purple", lwd = 2, lty = 2)
  abline(v = mean(vector1000Muestras), col = "red", lwd = 2, lty = 2)
  
  legend("topright", legend = c("Método 1", "Método 2", "Media"), col = c("green", "purple", "red"), lty = 2, lwd = 2)

El anterior gráfico presenta la distribucion de las medias obtenidas mediante el método de estimación bootstrap. La media se representa con la línea roja con un valor aproximado a 5.5, los intervalos de confiaza se representan con las líneas verde y púrpura (método 1 y método 2 respectivamente).

Los valores de los intervalos de confianza en el P2.5 son: 4.554 (Método 1) y 4.396 (Método2) y en el P97.5 son: 6.666 (Método 1) y 6.508 (Método 2) , por lo tanto ambos métodos proporcionan estimaciones útiles del intervalo de confianza para la media de la eficiencia de combustible, pero es importante contar con una muestra representativa.