EJ1-M2-BOOTSTRAP / Patricio Hermosillo / A01567036

# Datos

meses <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
           "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre",
           "Diciembre")

ocupacion <- c(78, 82, 75, 80, 85, 88, 92, 90, 86, 84, 80, 83)

hotel <- data.frame(mes = meses, ocupacion = ocupacion)
hotel

##           mes ocupacion
## 1       Enero        78
## 2     Febrero        82
## 3       Marzo        75
## 4       Abril        80
## 5        Mayo        85
## 6       Junio        88
## 7       Julio        92
## 8      Agosto        90
## 9  Septiembre        86
## 10    Octubre        84
## 11  Noviembre        80
## 12  Diciembre        83

mean(ocupacion)   # media observada

## [1] 83.58333

sd(ocupacion)     # desviacion estandar observada

## [1] 4.981025

# Funcion de bootstrap
# Genera n_iteraciones submuestras del mismo tamano que los datos
# originales (12), muestreando con reemplazo, y guarda la media de
# cada submuestra.

bootstrap_media <- function(datos, n_iteraciones) {

  medias <- numeric(n_iteraciones)

  for (i in 1:n_iteraciones) {
    muestra <- sample(datos, size = length(datos), replace = TRUE)
    medias[i] <- mean(muestra)
  }

  return(medias)
}

# 1) Bootstrap con 1,000 repeticiones

set.seed(123)
medias_1000 <- bootstrap_media(ocupacion, 1000)

mean(medias_1000)

## [1] 83.57342

ic_1000 <- quantile(medias_1000, c(0.025, 0.975))
ic_1000

##     2.5%    97.5% 
## 80.83125 86.25208

hist(medias_1000,
     breaks = 30,
     main = "Bootstrap - 1,000 repeticiones",
     xlab = "Ocupacion promedio (%)",
     ylab = "Frecuencia",
     col = "lightblue")
abline(v = ic_1000, col = "red", lwd = 2, lty = 2)
abline(v = mean(ocupacion), col = "darkgreen", lwd = 2)

#2)  Bootstrap con 100,000 repeticiones 
# Se deja la misma semilla para que la comparacion sea contra el
# numero de iteraciones y no contra otra corrida aleatoria.

set.seed(123)
medias_100k <- bootstrap_media(ocupacion, 100000)

mean(medias_100k)

## [1] 83.58052

ic_100k <- quantile(medias_100k, c(0.025, 0.975))
ic_100k

##     2.5%    97.5% 
## 80.91667 86.25000

hist(medias_100k,
     breaks = 50,
     main = "Bootstrap - 100,000 repeticiones",
     xlab = "Ocupacion promedio (%)",
     ylab = "Frecuencia",
     col = "lightblue")
abline(v = ic_100k, col = "red", lwd = 2, lty = 2)
abline(v = mean(ocupacion), col = "darkgreen", lwd = 2)

# Comparacion de los dos intervalos
comparacion <- data.frame(
  repeticiones = c(1000, 100000),
  media = c(mean(medias_1000), mean(medias_100k)),
  limite_inf = c(ic_1000[1], ic_100k[1]),
  limite_sup = c(ic_1000[2], ic_100k[2]),
  amplitud = c(ic_1000[2] - ic_1000[1], ic_100k[2] - ic_100k[1])
)
comparacion

##   repeticiones    media limite_inf limite_sup amplitud
## 1        1e+03 83.57342   80.83125   86.25208 5.420833
## 2        1e+05 83.58052   80.91667   86.25000 5.333333

# 3) Correccion: diciembre fue 73% y no 83%

ocupacion_corr <- ocupacion
ocupacion_corr[12] <- 73

mean(ocupacion_corr)

## [1] 82.75

sd(ocupacion_corr)

## [1] 5.848465

set.seed(123)
medias_1000_corr <- bootstrap_media(ocupacion_corr, 1000)
ic_1000_corr <- quantile(medias_1000_corr, c(0.025, 0.975))
ic_1000_corr

##     2.5%    97.5% 
## 79.50000 85.91875

set.seed(123)
medias_100k_corr <- bootstrap_media(ocupacion_corr, 100000)
ic_100k_corr <- quantile(medias_100k_corr, c(0.025, 0.975))
ic_100k_corr

##     2.5%    97.5% 
## 79.50000 85.91667

hist(medias_100k_corr,
     breaks = 50,
     main = "Bootstrap con diciembre corregido (73%) - 100,000 repeticiones",
     xlab = "Ocupacion promedio (%)",
     ylab = "Frecuencia",
     col = "lightpink")
abline(v = ic_100k_corr, col = "red", lwd = 2, lty = 2)
abline(v = mean(ocupacion_corr), col = "darkgreen", lwd = 2)

# Tabla final con los cuatro escenarios
resultados <- data.frame(
  escenario = c("Original 1,000", "Original 100,000",
                "Corregido 1,000", "Corregido 100,000"),
  media = c(mean(medias_1000), mean(medias_100k),
            mean(medias_1000_corr), mean(medias_100k_corr)),
  limite_inf = c(ic_1000[1], ic_100k[1], ic_1000_corr[1], ic_100k_corr[1]),
  limite_sup = c(ic_1000[2], ic_100k[2], ic_1000_corr[2], ic_100k_corr[2])
)
resultados$amplitud <- resultados$limite_sup - resultados$limite_inf
resultados

##           escenario    media limite_inf limite_sup amplitud
## 1    Original 1,000 83.57342   80.83125   86.25208 5.420833
## 2  Original 100,000 83.58052   80.91667   86.25000 5.333333
## 3   Corregido 1,000 82.77758   79.50000   85.91875 6.418750
## 4 Corregido 100,000 82.74665   79.50000   85.91667 6.416667

# 4) Riesgo de caer por debajo del 80%
# Proporcion de submuestras bootstrap cuya media queda por debajo
# del umbral de 80%, antes y despues de la correccion.

mean(medias_100k < 80)

## [1] 0.00381

mean(medias_100k_corr < 80)

## [1] 0.04367