1 0) Paquetes (instalación + carga)

Qué hace (estadísticamente): prepara el entorno para reproducibilidad y visualización clara. No afecta la inferencia, pero asegura transparencia y replicabilidad.

pkgs <- c(
  "tidyverse",  # dplyr, ggplot2, tidyr, readr...
  "janitor",    # tablas y porcentajes
  "broom",      # resultados 'tidy'
  "gt",         # tablas lindas
  "scales",     # formatos (porcentaje, coma)
  "GGally",     # ggpairs para correlación/regresión
  "purrr"       # map/map_dfr en simulaciones
)
instalar <- setdiff(pkgs, rownames(installed.packages()))
if(length(instalar)) install.packages(instalar, repos = "https://cran.rstudio.com/")
invisible(lapply(pkgs, library, character.only = TRUE))

# Tema visual global
theme_set(theme_minimal(base_size = 13))
update_geom_defaults("point", list(alpha = 0.8))
set.seed(1234)

2 1) Muestreo (repaso + simulación)

Qué hace (estadísticamente): construimos una población sintética con una variable explicativa x y una variable de interés y. Comparamos la variabilidad de la media muestral bajo dos diseños: aleatorio simple y estratificado proporcional. La idea es ilustrar cómo el diseño impacta en el error muestral (varianza del estimador).

# Población 'sintética'
N <- 50000
pob <- tibble(
  id = 1:N,
  x  = rnorm(N, 50, 10),
  estrato = cut(x, breaks = c(-Inf, 45, 55, Inf),
                labels = c("Bajo","Medio","Alto")),
  y  = 10 + 0.8*x + rnorm(N, 0, 8) # variable de interés
)

# Muestreo aleatorio simple
m_aleatorio_simple <- function(n) dplyr::sample_n(pob, n)

# Muestreo estratificado robusto (sin slice_sample en data mask)
m_estratificado <- function(n_total, alloc = c("proporcional","igual")) {
  alloc <- match.arg(alloc)
  tamaños <- pob %>% count(estrato, name = "N_g")
  K <- nrow(tamaños)
  if (alloc == "proporcional") {
    tamaños <- tamaños %>%
      mutate(
        cuota_cont = n_total * N_g / sum(N_g),
        n_g_floor  = floor(cuota_cont),
        resto      = cuota_cont - n_g_floor
      )
    faltan <- n_total - sum(tamaños$n_g_floor)
    tamaños$n_g <- tamaños$n_g_floor
    if (faltan > 0) {
      idx_extra <- order(tamaños$resto, decreasing = TRUE)[seq_len(faltan)]
      tamaños$n_g[idx_extra] <- tamaños$n_g[idx_extra] + 1
    }
  } else {
    base <- floor(n_total / K)
    tamaños <- tamaños %>% mutate(n_g = base)
    faltan <- n_total - sum(tamaños$n_g)
    if (faltan > 0) {
      tamaños$n_g[seq_len(faltan)] <- tamaños$n_g[seq_len(faltan)] + 1
    }
  }
  # Split por estrato y muestreo base R (evita problemas de visibilidad de n_g)
  grupos <- split(pob, droplevels(pob$estrato))
  n_por_grupo <- setNames(tamaños$n_g, as.character(tamaños$estrato))
  n_por_grupo <- n_por_grupo[names(grupos)]
  mues <- Map(function(df, k) {
    k <- min(k, nrow(df))
    df[sample.int(nrow(df), k, replace = FALSE), , drop = FALSE]
  }, grupos, n_por_grupo)
  bind_rows(mues)
}

# Simulación: comparación de diseños
B <- 200; n <- 400
verdad <- mean(pob$y)

res <- purrr::map_dfr(1:B, \(b){
  s_as  <- m_aleatorio_simple(n)
  s_est <- m_estratificado(n_total = n, alloc = "proporcional")
  tibble(
    rep = b,
    diseno = c("Alea. simple", "Estratificado (prop.)"),
    media_muestral = c(mean(s_as$y), mean(s_est$y))
  )
})

ggplot(res, aes(diseno, media_muestral)) +
  geom_violin(trim = TRUE) +
  geom_point(position = position_jitter(width=.05, height=0), alpha=.5, size=1) +
  geom_hline(yintercept = verdad, linetype = 2) +
  labs(title="Variabilidad de la media muestral por diseño",
       subtitle=paste("Media poblacional =", round(verdad,2)),
       x=NULL, y="Media muestral")

Lectura: el estratificado proporcional suele reducir varianza si la variable de interés difiere entre estratos (control del diseño).

3 2) Estimación puntual

Qué hace (estadísticamente): estimamos parámetros con sus estimadores: la media poblacional \(\mu\) con \(\bar{y}\) y una proporción poblacional \(p\) con \(\hat{p}\).

muestra <- dplyr::sample_n(pob, 500)
tibble(
  media_y = mean(muestra$y),
  prop_estrato_alto = mean(muestra$estrato=="Alto")
) %>%
  mutate(prop_estrato_alto = percent(prop_estrato_alto)) %>%
  gt() %>% tab_header(title="Estimadores puntuales")

media_y	prop_estrato_alto
Estimadores puntuales
49.54543	30%

4 3) Intervalos de confianza (IC)

Qué hace (estadísticamente): construye un rango de valores plausibles para el parámetro con un nivel de confianza \(1-\alpha\). Para media usamos t-Student (varianza poblacional desconocida); para proporción usamos normal (aprox. de Wald).

alpha <- 0.10  # 90%
xbar  <- mean(muestra$y); s <- sd(muestra$y); n <- nrow(muestra)
tcrit <- qt(1 - alpha/2, df = n-1)
se    <- s/sqrt(n)
LI    <- xbar - tcrit*se
LS    <- xbar + tcrit*se
e     <- (LS-LI)/2

tibble(`IC 90% μ` = sprintf("(%.2f ; %.2f)", LI, LS),
       `x̄` = round(xbar,2), `e` = round(e,2)) %>% gt()

IC 90% μ	x̄	e
(48.73 ; 50.36)	49.55	0.82

# Gráfico del IC
ggplot(tibble(LI, xbar, LS)) +
  geom_errorbar(aes(x=1, ymin=LI, ymax=LS), width=.07, linewidth=1)+
  geom_point(aes(1, xbar), size=3)+
  coord_flip()+
  scale_x_continuous(breaks=NULL)+
  labs(title="IC 90% para la media de y", y="y", x="")

IC para proporción:

p_hat <- mean(muestra$estrato=="Alto"); z <- qnorm(1 - alpha/2)
se_p  <- sqrt(p_hat*(1-p_hat)/n)
LIp   <- p_hat - z*se_p; LSp <- p_hat + z*se_p

tibble(`IC 90% para p(Alto)` = sprintf("(%.3f ; %.3f)", LIp, LSp),
       `p̂` = percent(p_hat)) %>% gt()

IC 90% para p(Alto)	p̂
(0.270 ; 0.338)	30%

5 4) Pruebas de hipótesis (1 muestra)

Qué hace (estadísticamente): contrasta \(H_0: \mu=\mu_0\) contra \(H_1\) (unilateral aquí). Reportamos estadístico de prueba, valor-p y decisión al nivel \(\alpha\).

# H0: μ = μ0 vs H1: μ > μ0
mu0   <- 50
t_est <- (xbar - mu0)/se
pval  <- 1 - pt(t_est, df = n-1)

tibble(
  t = round(t_est,3), gl = n-1,
  `p-valor` = signif(pval,3),
  Decision = ifelse(pval<0.05,"Rechazar H0","No rechazar H0")
) %>% gt()

t	gl	p-valor	Decision
-0.918	499	0.82	No rechazar H0

Potencia (idea simulada): probabilidad de rechazar H0 cuando es falsa (aquí con \(\mu_{true}=50.8\)).

mu_true <- 50.8
B <- 1000
rech <- replicate(B, {
  x <- rnorm(n, mean = mu_true, sd = s)
  t_est <- (mean(x)-mu0)/(sd(x)/sqrt(n))
  (1 - pt(t_est, df = n-1)) < 0.05
})
mean(rech)  # potencia aproximada

## [1] 0.477

6 5) Asociación entre cualitativas (χ² + Cramér’s V)

Qué hace (estadísticamente): el test \(\chi^2\) evalúa independencia entre dos cualitativas; Cramér’s V mide intensidad de asociación en \([0,1]\).

# Variable ficticia para ejemplo (tipo de vivienda)
muestra <- muestra %>%
  mutate(tipo_viv = ifelse(runif(n()) < 0.6, "Casa", "Depto"))

# Tabla de contingencia y test
tab_chi <- xtabs(~ estrato + tipo_viv, data = muestra)
chi <- chisq.test(tab_chi, correct = FALSE)

chisq  <- unname(chi$statistic); N <- sum(tab_chi)
r <- nrow(tab_chi); c <- ncol(tab_chi)
cramer_v <- sqrt(chisq/(N*min(r-1, c-1)))

# Heatmap de residuos estandarizados (construcción segura, sin pivot_* ni rownames_to_column)
df_std <- chi$stdres
if (is.null(rownames(df_std))) rownames(df_std) <- rownames(tab_chi)
if (is.null(colnames(df_std))) colnames(df_std) <- colnames(tab_chi)

res_df <- tibble(
  estrato  = rep(rownames(df_std), times = ncol(df_std)),
  tipo_viv = rep(colnames(df_std), each  = nrow(df_std)),
  resid    = as.vector(df_std)
)

ggplot(res_df, aes(tipo_viv, estrato, fill = resid))+
  geom_tile()+
  geom_text(aes(label = sprintf("%.1f", resid)), size=3)+
  scale_fill_gradient2(low="steelblue", mid="white", high="tomato", midpoint=0)+
  labs(title="Asociación: Estrato × Tipo de vivienda",
       subtitle=paste0("χ²=", round(chisq,1),
                       ", p=", scales::pvalue(chi$p.value, add_p = TRUE),
                       ", V=", round(cramer_v,3)),
       x=NULL, y=NULL, fill="Residuo\nstd")

# Barras apiladas por fila (proporciones)
as.data.frame(tab_chi) %>%
  as_tibble() %>%
  rename(estrato = estrato, tipo_viv = tipo_viv, n = Freq) %>%
  group_by(estrato) %>%
  mutate(prop = n/sum(n)) %>%
  ggplot(aes(estrato, prop, fill = tipo_viv)) +
  geom_col(position="fill")+
  geom_text(aes(label = percent(prop, accuracy = 1)),
            position = position_fill(vjust=.5), size=3, color="white")+
  scale_y_continuous(labels = percent)+
  labs(title="Composición por estrato", x=NULL, y="Porcentaje", fill="Vivienda")

7 6) Relación entre cuantitativas: correlación & regresión simple

Qué hace (estadísticamente): relaciona dos variables numéricas. Reportamos correlación (\(-1\) a \(1\)) y ajustamos una regresión lineal \(E[Y|X]=\beta_0+\beta_1 X\).

# Datos simulados con correlación positiva
n2 <- 300
actividad   <- rnorm(n2, 100, 15)
recaudacion <- 50 + 1.8*actividad + rnorm(n2, 0, 25)
df_reg <- tibble(actividad, recaudacion)

# Dispersión con recta de regresión
ggplot(df_reg, aes(actividad, recaudacion))+
  geom_point()+
  geom_smooth(method="lm", se=TRUE)+
  labs(title="Actividad económica vs Recaudación")

# Correlación
cor(df_reg$actividad, df_reg$recaudacion)

## [1] 0.7211607

# Regresión lineal
mod <- lm(recaudacion ~ actividad, data = df_reg)
broom::tidy(mod)

broom::glance(mod)

# Matriz de gráficos
GGally::ggpairs(df_reg)

8 7) Apéndice: funciones rápidas

Qué hace (estadísticamente): encapsula rutinas para IC de media y proporción, facilitando reutilización en clases y prácticas.

ic_media <- function(x, conf=0.95){
  x <- na.omit(x); n <- length(x); xbar <- mean(x); s <- sd(x)
  tcrit <- qt(1-(1-conf)/2, df=n-1); se <- s/sqrt(n)
  c(LI = xbar - tcrit*se, Est = xbar, LS = xbar + tcrit*se)
}
ic_prop <- function(x, conf=0.95){ # x lógico/0-1
  p <- mean(x); n <- length(x); z <- qnorm(1-(1-conf)/2)
  se <- sqrt(p*(1-p)/n); c(LI = p - z*se, Est = p, LS = p + z*se)
}

# Ejemplos
ic_media(muestra$y, .90)

##       LI      Est       LS 
## 48.72933 49.54543 50.36154

ic_prop(muestra$estrato=="Alto", .90)

##        LI       Est        LS 
## 0.2701636 0.3040000 0.3378364

8.1 Cómo publicar en RPubs

Abrí este archivo .Rmd en RStudio: File → Open File…
Clic en Knit → elegí HTML.
En la vista previa, clic en Publish (o RPubs), poné título y descripción, aceptar.

Sugerencia: si preferís Quarto, guardá como .qmd y usá quarto publish.

Clase 4 — Inferencia Estadística (RStudio)

Juan Pablo Tedesca

2025-10-30 18:41