Evaluación Ejercicio 3

Daniel Molina 2025-11-12

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

# Definir la población
df <- data.frame(peso = ChickWeight$weight, dieta = ChickWeight$Diet)

# Extraer una muestra aleatoria simple sin reemplazo de tamaño 100 y estimar la media poblacional.
N <- nrow(df) 
n <- 100     

indices_mas <- sample(1:N, size = n, replace = FALSE)
muestra_mas <- df[indices_mas, ]
media_estimada_mas <- mean(muestra_mas$peso)

cat(paste("Media estimada:", media_estimada_mas))

## Media estimada: 111.5

# Si consideramos que los pollos que siguieron una determinada dieta como un estrato, construir muestras con asignación proporcional y con asignación optima.
info_estratos <- df %>%
  group_by(dieta) %>%
  summarise(
    N_h = n(),
    S_h = sd(peso)
  ) %>%
  mutate(
    W_h = N_h / N,
    N_h_S_h = N_h * S_h
  )

info_estratos$n_prop <- round(n * info_estratos$W_h)
sum_NhSh <- sum(info_estratos$N_h_S_h)
info_estratos$n_opt <- round(n * info_estratos$N_h_S_h / sum_NhSh)

print(info_estratos[, c("dieta", "n_prop", "n_opt")])

## # A tibble: 4 × 3
##   dieta n_prop n_opt
##   <fct>  <dbl> <dbl>
## 1 1         38    32
## 2 2         21    22
## 3 3         21    26
## 4 4         20    21

# Construyendo la muestra
list_estratos <- split(df, df$dieta)
muestra_prop_lista <- mapply(
  function(estrato_df, n_h) estrato_df[sample(1:nrow(estrato_df), n_h), ],
  list_estratos, 
  info_estratos$n_prop, 
  SIMPLIFY = FALSE
)
muestra_prop <- bind_rows(muestra_prop_lista)
muestra_opt_lista <- mapply(
  function(estrato_df, n_h) estrato_df[sample(1:nrow(estrato_df), n_h), ],
  list_estratos, 
  info_estratos$n_opt, 
  SIMPLIFY = FALSE
)
muestra_opt <- bind_rows(muestra_opt_lista)

cat(paste("Tamaño muestra proporcional:", nrow(muestra_prop)))

## Tamaño muestra proporcional: 100

cat(paste("\nTamaño muestra óptima:", nrow(muestra_opt)))

## 
## Tamaño muestra óptima: 101

# Estimar las medias poblacionales de los estratos.
medias_estrato_prop <- muestra_prop %>%
  group_by(dieta) %>%
  summarise(media_h_estimada = mean(peso))
print(medias_estrato_prop)

## # A tibble: 4 × 2
##   dieta media_h_estimada
##   <fct>            <dbl>
## 1 1                 104.
## 2 2                 120.
## 3 3                 137.
## 4 4                 142.

# Medias estimadas por estrato (Óptima)
medias_estrato_opt <- muestra_opt %>%
  group_by(dieta) %>%
  summarise(media_h_estimada = mean(peso))
print(medias_estrato_opt)

## # A tibble: 4 × 2
##   dieta media_h_estimada
##   <fct>            <dbl>
## 1 1                 102.
## 2 2                 125.
## 3 3                 159.
## 4 4                 146.

# Estimar la media poblacional general con los dos tipos de muestra (proporcional y optimo).
estim_prop <- left_join(medias_estrato_prop, info_estratos[, c("dieta", "W_h")], by = "dieta")
estim_opt <- left_join(medias_estrato_opt, info_estratos[, c("dieta", "W_h")], by = "dieta")

media_gen_prop <- sum(estim_prop$W_h * estim_prop$media_h_estimada)
media_gen_opt <- sum(estim_opt$W_h * estim_opt$media_h_estimada)

cat(paste("Media General Estimada (Proporcional):", round(media_gen_prop, 4)))

## Media General Estimada (Proporcional): 121.8296

cat(paste("\nMedia General Estimada (Óptima):", round(media_gen_opt, 4)))

## 
## Media General Estimada (Óptima): 127.3481