Problema 4 - Estimación Bootstrap

Para la resolución de este problema se siguió la siguiente aproximación:

Interpretaciones

A juzgar únicamente por los valores de la mediana (4.97) y la media (5.53) de la muestra original, parece que estamos frente a una distribución ligeramente sesgada hacia la derecha. Esta situación se replica en la distribución de las medias de bootstrap (la frecuencia de las medias simuladas) donde la media de las medias (5.52) se ubica a la derecha de la mediana (5.50), y cuyas gráficas de densidades permiten observar la cola alargada de la derecha. Esto puede sugerir que el procedimiento bootstrap está replicando de manera efectiva las características de la muestra original.

Adicionalmente, se debe tener en cuenta que ambos intervalos tienen una amplitud cercana a los 1.7 puntos de unidades, una variación absoluta poca, pero en cuanto su ubicación en la distribución distan debido a que el Método 2 toma la media muestral como un punto de referencia y refleja cualquier sesgo potencial en la estimación de la media, haciendo que el intervalo sea más simétrico respecto a la media de la muestra original; mientras que el Método 1 directamente trabaja con los percentiles de las medias. Así, se podría decir que en este caso parece ser que el Método 2 puede ser un poco más confiable en cuanto reduce el efecto del sesgo positivo de la muestra de muestras. No obstante, y como comentario final, la muestra original es demasiado pequeña y los dos métodos no distan mucho en cuanto sus valores de manera que su utilidad queda sujeta al alcance que se le quiera dar a su uso.

# Configuración de los datos y parámetros iniciales
set.seed(30)  # Para reproducibilidad
muestra <- c(7.69, 4.97, 4.56, 6.49, 4.34, 6.24, 4.45)  # Datos de eficiencia de combustible


n <- length(muestra)  # Tamaño de la muestra
k <- 1000  # Número de muestras bootstrap

# Función para realizar el bootstrap
bootstrap_means <- replicate(k, {
  muestra_bootstrap <- sample(muestra, size = n, replace = TRUE)
  mean(muestra_bootstrap)  # Media de la muestra bootstrap
})

# Cálculo de los percentiles (2.5 y 97.5)
percentiles <- as.numeric(quantile(bootstrap_means, probs = c(0.025, 0.975)))

# Método 1: Intervalo de confianza basado en los percentiles
IC_metodo_1 <- percentiles

# Método 2: Intervalo de confianza ajustado
media_muestra <- mean(muestra)
IC_metodo_2 <- c(2 * media_muestra - percentiles[2], 2 * media_muestra - percentiles[1])

# Cargar la librería necesaria
library(kableExtra)

# Crear un data frame con los resultados
resultados <- data.frame(
  Método = c("Método 1", "Método 2"),
  `Límite Inferior` = c(IC_metodo_1[1], IC_metodo_2[1]),
  `Límite Superior` = c(IC_metodo_1[2], IC_metodo_2[2])
)

# Mostrar la tabla con formato mejorado
resultados %>%
  kbl(caption = "Tabla 1: Intervalos de confianza por métodos",align = "cc") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = TRUE)
Tabla 1: Intervalos de confianza por métodos
Método Límite.Inferior Límite.Superior
Método 1 4.7480 6.450071
Método 2 4.6185 6.320571 
# Calcular la mediana de la muestra original
mediana_muestra <- median(muestra)

# Calcular la media y mediana de las medias bootstrap
media_bootstrap <- mean(bootstrap_means)
mediana_bootstrap <- median(bootstrap_means)

# Crear un data frame con los resultados de la segunda tabla
resultados_adicionales <- data.frame(
  `Estadístico` = c("Media de la muestra original", "Mediana de la muestra original", 
                    "Media de las medias bootstrap", "Mediana de las medianas bootstrap"),
  `Valor` = c(media_muestra, mediana_muestra, media_bootstrap, mediana_bootstrap)
)

# Mostrar la segunda tabla con formato mejorado
resultados_adicionales %>%
  kbl(caption = "Tabla 2: Medias y medianas de la muestra original y bootstrap", align = "cc") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = TRUE)
Tabla 2: Medias y medianas de la muestra original y bootstrap
Estadístico Valor
Media de la muestra original 5.534286
Mediana de la muestra original 4.970000
Media de las medias bootstrap 5.526047
Mediana de las medianas bootstrap 5.507857 
# Gráfico del bootstrap
library(ggplot2)

# Histograma de las medias bootstrap con los intervalos de confianza marcados
ggplot(data.frame(bootstrap_means), aes(x = bootstrap_means)) +
  geom_histogram(binwidth = 0.1, fill = "lightgrey", color = "black", alpha = 0.7) +
  geom_vline(xintercept = percentiles, linetype = "dashed", color = "red", size = 1) +
  geom_vline(xintercept = IC_metodo_2, linetype = "dashed", color = "blue", size = 1) +
  ggtitle("Gráfica 1: Distribución de las medias simuladas - Bootstrap") +
  xlab("Medias Bootstrap (valores obtenidos en las simulaciones)") +
  ylab("Frecuencia") +
  theme_bw() +
  annotate("text", x = percentiles[1]+0.6, y = 75, label = "Método 1 - P2.5", color = "red", hjust = 1) +
  annotate("text", x = percentiles[2]+0.04, y = 75, label = "Método 1 - P97.5", color = "red", hjust = 0) +
  annotate("text", x = IC_metodo_2[1]+0.6, y = 50, label = "Método 2 - Inferior", color = "blue", hjust = 1) +
  annotate("text", x = IC_metodo_2[2]+0.04, y = 50, label = "Método 2 - Superior", color = "blue", hjust = 0)

# Gráfico de la densidad de las medias bootstrap con los intervalos de confianza marcados
ggplot(data.frame(bootstrap_means), aes(x = bootstrap_means)) +
  geom_density(fill = "lightgrey", color = "black", alpha = 0.7) +
  geom_vline(xintercept = percentiles, linetype = "dashed", color = "red", size = 1) +
  geom_vline(xintercept = IC_metodo_2, linetype = "dashed", color = "blue", size = 1) +
  ggtitle("Gráfica 2: Distribución de densidad de las medias simuladas - Bootstrap") +
  xlab("Medias Bootstrap (valores obtenidos en las simulaciones)") +
  ylab("Densidad") +
  theme_bw() +
  annotate("text", x = percentiles[1]+0.6, y = 0.75, label = "Método 1 - P2.5", color = "red", hjust = 1) +
  annotate("text", x = percentiles[2]+0.04, y = 0.75, label = "Método 1 - P97.5", color = "red", hjust = 0) +
  annotate("text", x = IC_metodo_2[1]+0.65, y = 0.6, label = "Método 2 - Inferior", color = "blue", hjust = 1) +
  annotate("text", x = IC_metodo_2[2]+0.04, y = 0.6, label = "Método 2 - Superior", color = "blue", hjust = 0)