examen 9

library(ggplot2)
library(dplyr)

## Warning: package 'dplyr' was built under R version 4.3.3

## 
## 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 <- data.frame(peso = ChickWeight$weight, dieta = ChickWeight$Diet)
n_total <- 120
# Tabla de estratos con tamaños, desviaciones y pesos
tabla_estratos <- df %>%
group_by(dieta) %>%
summarise(N_h = n(), S_h = sd(peso)) %>%
mutate(peso = N_h / sum(N_h)) %>%
mutate(n_proporcional = round(n_total * peso, 0)) %>%
mutate(peso_optimo = N_h * S_h) %>%
mutate(n_neyman = round(n_total * peso_optimo / sum(peso_optimo), 0))

tabla_estratos

## # A tibble: 4 × 7
##   dieta   N_h   S_h  peso n_proporcional peso_optimo n_neyman
##   <fct> <int> <dbl> <dbl>          <dbl>       <dbl>    <dbl>
## 1 1       220  56.7 0.381             46      12464.       38
## 2 2       120  71.6 0.208             25       8593.       26
## 3 3       120  86.5 0.208             25      10385.       31
## 4 4       118  68.8 0.204             24       8122.       25

set.seed(123)
muestras_proporcionales_list <- list()

for(i in 1:nrow(tabla_estratos)){
estrato_i <- tabla_estratos$dieta[i]
n_i <- tabla_estratos$n_proporcional[i]

muestra_i <- df %>% filter(dieta == estrato_i) %>% sample_n(n_i)
muestras_proporcionales_list[[i]] <- muestra_i
}

muestras_proporcionales <- bind_rows(muestras_proporcionales_list)

# Medias por estrato

medias_estratos_proporcionales <- muestras_proporcionales %>%
group_by(dieta) %>%
summarise(media_estrato = mean(peso))

medias_estratos_proporcionales

## # A tibble: 4 × 2
##   dieta media_estrato
##   <fct>         <dbl>
## 1 1              95.6
## 2 2             123. 
## 3 3             113. 
## 4 4             124.

# Media general ponderada

tabla_estratos <- tabla_estratos %>% arrange(dieta)
medias_estratos_proporcionales <- medias_estratos_proporcionales %>% arrange(dieta)

media_general_proporcional <- sum(medias_estratos_proporcionales$media_estrato * tabla_estratos$peso)
cat("Media poblacional estimada (Afijación Proporcional):", round(media_general_proporcional,2), "\n")

## Media poblacional estimada (Afijación Proporcional): 110.77

set.seed(123)
muestras_neyman_list <- list()

for(i in 1:nrow(tabla_estratos)){
estrato_i <- tabla_estratos$dieta[i]
n_i <- tabla_estratos$n_neyman[i]

muestra_i <- df %>% filter(dieta == estrato_i) %>% sample_n(n_i)
muestras_neyman_list[[i]] <- muestra_i
}

muestras_neyman <- bind_rows(muestras_neyman_list)

# Medias por estrato

medias_estratos_neyman <- muestras_neyman %>%
group_by(dieta) %>%
summarise(media_estrato = mean(peso))

medias_estratos_neyman

## # A tibble: 4 × 2
##   dieta media_estrato
##   <fct>         <dbl>
## 1 1              91.6
## 2 2             123. 
## 3 3             148. 
## 4 4             116.

# Media general ponderada

medias_estratos_neyman <- medias_estratos_neyman %>% arrange(dieta)
media_general_neyman <- sum(medias_estratos_neyman$media_estrato * tabla_estratos$peso)
cat("Media poblacional estimada (Afijación Óptima - Neyman):", round(media_general_neyman,2), "\n")

## Media poblacional estimada (Afijación Óptima - Neyman): 114.82