Librerias
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
data frame
df <- data.frame(
peso = ChickWeight$weight,
dieta = ChickWeight$Diet
)
head(df)
## peso dieta
## 1 42 1
## 2 51 1
## 3 59 1
## 4 64 1
## 5 76 1
## 6 93 1
str(df)
## 'data.frame': 578 obs. of 2 variables:
## $ peso : num 42 51 59 64 76 93 106 125 149 171 ...
## $ dieta: Factor w/ 4 levels "1","2","3","4": 1 1 1 1 1 1 1 1 1 1 ...
summary(df)
## peso dieta
## Min. : 35.0 1:220
## 1st Qu.: 63.0 2:120
## Median :103.0 3:120
## Mean :121.8 4:118
## 3rd Qu.:163.8
## Max. :373.0
set.seed(123)
n_muestra <- 120
#muestra aleatoria simple sin reemplazo
indices_mas <- sample(1:nrow(df), n_muestra, replace = FALSE)
muestra_mas <- df[indices_mas, ]
# Estimación de media poblacional a partir de la muestra
media_mas <- mean(muestra_mas$peso)
cat("Media estimada con MAS:", round(media_mas, 2), "\n")
## Media estimada con MAS: 121.02
estratos <- df %>% group_by(dieta) %>% summarise(Nh = n(), Sh = sd(peso))
estratos
## # A tibble: 4 × 3
## dieta Nh Sh
## <fct> <int> <dbl>
## 1 1 220 56.7
## 2 2 120 71.6
## 3 3 120 86.5
## 4 4 118 68.8
# Proporciones de cada estrato
estratos <- estratos %>% mutate(
peso = Nh / sum(Nh),
nh_proporcional = round(n_muestra * peso, 0)
)
estratos
## # A tibble: 4 × 5
## dieta Nh Sh peso nh_proporcional
## <fct> <int> <dbl> <dbl> <dbl>
## 1 1 220 56.7 0.381 46
## 2 2 120 71.6 0.208 25
## 3 3 120 86.5 0.208 25
## 4 4 118 68.8 0.204 24
set.seed(123)
muestra_prop <- bind_rows(
df %>% filter(dieta == "1") %>% sample_n(estratos$nh_proporcional[1]),
df %>% filter(dieta == "2") %>% sample_n(estratos$nh_proporcional[2]),
df %>% filter(dieta == "3") %>% sample_n(estratos$nh_proporcional[3]),
df %>% filter(dieta == "4") %>% sample_n(estratos$nh_proporcional[4])
)
# Medias por estrato
media_estratos_prop <- muestra_prop %>% group_by(dieta) %>% summarise(media = mean(peso))
media_estratos_prop
## # A tibble: 4 × 2
## dieta media
## <fct> <dbl>
## 1 1 95.6
## 2 2 123.
## 3 3 113.
## 4 4 124.
# Estimación de la media poblacional general
estratos$media_muestra <- media_estratos_prop$media
estratos$Wh <- estratos$Nh / sum(estratos$Nh)
media_general_prop <- sum(estratos$Wh * estratos$media_muestra)
cat("Media poblacional estimada (Proporcional):", round(media_general_prop,2), "\n")
## Media poblacional estimada (Proporcional): 110.77
#Neyman
estratos <- estratos %>% mutate(
peso_neyman = Nh * Sh,
nh_neyman = round(n_muestra * peso_neyman / sum(peso_neyman), 0)
)
estratos
## # A tibble: 4 × 9
## dieta Nh Sh peso nh_proporcional media_muestra Wh peso_neyman
## <fct> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 220 56.7 0.381 46 95.6 0.381 12464.
## 2 2 120 71.6 0.208 25 123. 0.208 8593.
## 3 3 120 86.5 0.208 25 113. 0.208 10385.
## 4 4 118 68.8 0.204 24 124. 0.204 8122.
## # ℹ 1 more variable: nh_neyman <dbl>
# Muestra estratificada óptima
set.seed(123)
muestra_opt <- bind_rows(
df %>% filter(dieta == "1") %>% sample_n(estratos$nh_neyman[1]),
df %>% filter(dieta == "2") %>% sample_n(estratos$nh_neyman[2]),
df %>% filter(dieta == "3") %>% sample_n(estratos$nh_neyman[3]),
df %>% filter(dieta == "4") %>% sample_n(estratos$nh_neyman[4])
)
# Medias por estrato
media_estratos_opt <- muestra_opt %>% group_by(dieta) %>% summarise(media = mean(peso))
media_estratos_opt
## # A tibble: 4 × 2
## dieta media
## <fct> <dbl>
## 1 1 91.6
## 2 2 123.
## 3 3 148.
## 4 4 116.
# Estimación de la media poblacional general
estratos$media_muestra_opt <- media_estratos_opt$media
media_general_opt <- sum(estratos$Wh * estratos$media_muestra_opt)
cat("Media poblacional estimada (Optima):", round(media_general_opt,2), "\n")
## Media poblacional estimada (Optima): 114.82