Pregunta 9

Mónica Isabel Blanco 2025-11-13

library(ggplot2)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

df_poblacion <- data.frame(peso = ChickWeight$weight, dieta = ChickWeight$Diet)

set.seed(123)

media_poblacional_real <- mean(df_poblacion$peso)
sd_poblacional_real <- sd(df_poblacion$peso)
N_total <- nrow(df_poblacion)

cat("Tamaño Total de la Población (N):", N_total, "\n")

## Tamaño Total de la Población (N): 578

cat("Media Poblacional Real (μ):", round(media_poblacional_real, 4), "gramos\n")

## Media Poblacional Real (μ): 121.8183 gramos

cat("Desviación Estándar Poblacional Real (σ):", round(sd_poblacional_real, 4), "gramos\n")

## Desviación Estándar Poblacional Real (σ): 71.072 gramos

n_mas <- 120
muestra_mas <- sample_n(df_poblacion, size = n_mas, replace = FALSE)
media_estimada_mas <- mean(muestra_mas$peso)

error_estandar_mas <- sd_poblacional_real / sqrt(n_mas) * sqrt((N_total - n_mas) / (N_total - 1))

cat("Tamaño de Muestra (n):", n_mas, "\n")

## Tamaño de Muestra (n): 120

cat("Estimación de la Media:", round(media_estimada_mas, 4), "gramos\n")

## Estimación de la Media: 121.0167 gramos

cat("Error Estándar del Estimador (SE):", round(error_estandar_mas, 4), "\n")

## Error Estándar del Estimador (SE): 5.7803

cat("Diferencia con la media real (Error):", round(media_estimada_mas - media_poblacional_real, 4), "\n")

## Diferencia con la media real (Error): -0.8017

Calcular parámetros de los estratos

parametros_estratos <- df_poblacion %>%
  group_by(dieta) %>%
  summarise(Nh = n(),Sh = sd(peso),Mu_h = mean(peso)) %>%
  ungroup() %>% mutate(Wh = Nh / N_total)

print("Parámetros Reales de los Estratos:")

## [1] "Parámetros Reales de los Estratos:"

print(parametros_estratos)

## # A tibble: 4 × 5
##   dieta    Nh    Sh  Mu_h    Wh
##   <fct> <int> <dbl> <dbl> <dbl>
## 1 1       220  56.7  103. 0.381
## 2 2       120  71.6  123. 0.208
## 3 3       120  86.5  143. 0.208
## 4 4       118  68.8  135. 0.204

n_total <- 120
parametros_estratos <- parametros_estratos %>%
  mutate(n_proporcional = round(n_total * Wh, 0))
if (sum(parametros_estratos$n_proporcional) != n_total) {
  diff <- n_total - sum(parametros_estratos$n_proporcional)
  parametros_estratos$n_proporcional[1] <- parametros_estratos$n_proporcional[1] + diff
}

cat("Tamaños de Muestra (nh) Proporcionales (suma:", sum(parametros_estratos$n_proporcional), "):\n")

## Tamaños de Muestra (nh) Proporcionales (suma: 120 ):

print(select(parametros_estratos, dieta, Nh, n_proporcional))

## # A tibble: 4 × 3
##   dieta    Nh n_proporcional
##   <fct> <int>          <dbl>
## 1 1       220             46
## 2 2       120             25
## 3 3       120             25
## 4 4       118             24

parametros_estratos <- parametros_estratos %>%
  mutate(NhSh = Nh * Sh) %>%
  mutate(SumNhSh = sum(NhSh)) %>%
  mutate(n_optima = round(n_total * (NhSh / SumNhSh), 0))


cat("Tamaños de Muestra (nh) Óptimos (Neyman) (suma:", sum(parametros_estratos$n_optima), "):\n")

## Tamaños de Muestra (nh) Óptimos (Neyman) (suma: 120 ):

print(select(parametros_estratos, dieta, Nh, Sh, n_optima))

## # A tibble: 4 × 4
##   dieta    Nh    Sh n_optima
##   <fct> <int> <dbl>    <dbl>
## 1 1       220  56.7       38
## 2 2       120  71.6       26
## 3 3       120  86.5       31
## 4 4       118  68.8       25

muestra_proporcional <- df_poblacion %>%
  group_by(dieta) %>%
  sample_n(size = parametros_estratos$n_proporcional[parametros_estratos$dieta == unique(dieta)], 
           replace = FALSE) %>%
  ungroup()
medias_proporcional <- muestra_proporcional %>%
  group_by(dieta) %>%
  summarise(y_bar_h = mean(peso))

estimacion_proporcional <- medias_proporcional %>%
  left_join(select(parametros_estratos, dieta, Wh), by = "dieta") %>%
  mutate(weighted_mean = Wh * y_bar_h)

Y_bar_st_proporcional <- sum(estimacion_proporcional$weighted_mean)

cat("Estimación Estratificada Proporcional:", round(Y_bar_st_proporcional, 4), "gramos\n")

## Estimación Estratificada Proporcional: 126.377 gramos

cat("Diferencia con la media real:", round(Y_bar_st_proporcional - media_poblacional_real, 4), "\n")

## Diferencia con la media real: 4.5587

muestra_optima <- df_poblacion %>%
  group_by(dieta) %>%
  sample_n(size = parametros_estratos$n_optima[parametros_estratos$dieta == unique(dieta)], 
           replace = FALSE) %>%
  ungroup()

medias_optima <- muestra_optima %>%
  group_by(dieta) %>%
  summarise(y_bar_h = mean(peso))

estimacion_optima <- medias_optima %>%
  left_join(select(parametros_estratos, dieta, Wh), by = "dieta") %>%
  mutate(weighted_mean = Wh * y_bar_h)

Y_bar_st_optima <- sum(estimacion_optima$weighted_mean)

cat("Estimación Estratificada Óptima (Neyman) :", round(Y_bar_st_optima, 4), "gramos\n")

## Estimación Estratificada Óptima (Neyman) : 123.2408 gramos

cat("Diferencia con la media real:", round(Y_bar_st_optima - media_poblacional_real, 4), "\n")

## Diferencia con la media real: 1.4225

resumen_estimaciones <- data.frame(
  Metodo = c("Media Poblacional Real", "Muestreo Aleatorio Simple", "Estratificado Proporcional", "Estratificado Óptimo"),
  Estimacion = c(media_poblacional_real, media_estimada_mas, Y_bar_st_proporcional, Y_bar_st_optima)
)

# Calcular el error absoluto
resumen_estimaciones <- resumen_estimaciones %>%
  mutate(Error_Absoluto = abs(Estimacion - media_poblacional_real))

print(resumen_estimaciones)

##                       Metodo Estimacion Error_Absoluto
## 1     Media Poblacional Real   121.8183      0.0000000
## 2  Muestreo Aleatorio Simple   121.0167      0.8016724
## 3 Estratificado Proporcional   126.3770      4.5586718
## 4       Estratificado Óptimo   123.2408      1.4225009