library(foreign)
library(ggplot2)
library(dplyr)
library(readr)
library(rlang)
library(gt)Tarea 2
Muestreo
Lectura de datos
nombres_entidades <- data.frame(
entidad = sprintf("%02d", 1:32),
nombre_entidad = c("Aguascalientes", "Baja California", "Baja California Sur", "Campeche",
"Coahuila de Zaragoza", "Colima", "Chiapas", "Chihuahua",
"Ciudad de México", "Durango", "Guanajuato", "Guerrero",
"Hidalgo", "Jalisco", "México", "Michoacán de Ocampo",
"Morelos", "Nayarit", "Nuevo León", "Oaxaca", "Puebla",
"Querétaro", "Quintana Roo", "San Luis Potosí", "Sinaloa",
"Sonora", "Tabasco", "Tamaulipas", "Tlaxcala",
"Veracruz de Ignacio de la Llave", "Yucatán", "Zacatecas"),
stringsAsFactors = FALSE
)
datos <- read_csv("https://www.dropbox.com/scl/fi/fxoulsrr9zet1kp19uouv/DATOS17.csv?rlkey=zwbfba3mv2ktgdjy7xlns582n&st=jczta8wn&dl=1")
glimpse(datos)Rows: 20,000
Columns: 34
$ ENT_REGIS <chr> "20", "02", "15", "15", "02", "22", "22", "13", "22", "17",…
$ MUN_REGIS <chr> "557", "003", "118", "010", "002", "006", "016", "003", "01…
$ LOC_REGIS <chr> "0001", "0001", "0001", "0001", "0001", "0001", "0001", "00…
$ TAM_LOC_RE <dbl> 14, 11, 11, 6, 15, 11, 13, 8, 15, 13, 2, 6, 6, 15, 2, 16, 1…
$ DIA_REGIS <dbl> 22, 27, 6, 13, 5, 21, 5, 14, 5, 7, 20, 26, 26, 17, 17, 9, 4…
$ MES_REGIS <dbl> 2, 5, 1, 12, 7, 12, 4, 10, 8, 12, 7, 6, 10, 5, 11, 11, 1, 9…
$ ANIO_REGIS <dbl> 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017,…
$ REGIMEN_MA <dbl> 1, 9, 1, 1, 9, 2, 1, 2, 2, 1, 1, 2, 2, 1, 2, 2, 1, 1, 2, 9,…
$ GENERO <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ SEXO_CON1 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ EDAD_CON1 <dbl> 19, 29, 32, 34, 48, 25, 27, 32, 44, 22, 23, 19, 29, 31, 77,…
$ NACI_CON1 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2,…
$ OCUP_CON1 <dbl> 6, 2, 2, 1, 4, 2, 98, 98, 98, 2, 98, 11, 6, 98, 99, 99, 98,…
$ ENTRH_CON1 <chr> "20", "02", "22", "15", "02", "22", "22", "15", "22", "17",…
$ MUNRH_CON1 <chr> "557", "003", "014", "010", "002", "006", "016", "058", "01…
$ LOCRH_CON1 <chr> "0001", "0001", "0001", "0002", "0001", "0142", "0077", "00…
$ TLORH_CON1 <dbl> 6, 11, 15, 4, 15, 7, 1, 16, 15, 13, 5, 6, 1, 15, 16, 15, 15…
$ ESCOL_CON1 <dbl> 6, 7, 5, 7, 9, 5, 4, 6, 7, 6, 5, 6, 5, 5, 2, 9, 5, 5, 6, 7,…
$ CONACTCON1 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 9, 9, 1, 1, 1, 1,…
$ SITLABCON1 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 9, 9, 1, 1, 1, 1,…
$ POSTRACON1 <dbl> 3, 2, 2, 2, 9, 2, 2, 2, 2, 2, 2, 9, 2, 2, 9, 9, 2, 2, 1, 2,…
$ SEXO_CON2 <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
$ EDAD_CON2 <dbl> 18, 25, 25, 22, 37, 19, 30, 34, 38, 18, 22, 19, 25, 33, 62,…
$ NACI_CON2 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2,…
$ OCUP_CON2 <dbl> 11, 2, 98, 2, 98, 11, 11, 11, 98, 11, 11, 11, 98, 98, 99, 9…
$ ENTRH_CON2 <chr> "20", "30", "22", "15", "02", "22", "22", "13", "22", "17",…
$ MUNRH_CON2 <chr> "557", "070", "014", "010", "002", "006", "016", "003", "00…
$ LOCRH_CON2 <chr> "0001", "0032", "0001", "0001", "0001", "0142", "0077", "00…
$ TLORH_CON2 <dbl> 6, 1, 15, 6, 15, 7, 1, 8, 11, 13, 2, 6, 1, 15, 16, 15, 15, …
$ ESCOL_CON2 <dbl> 5, 7, 5, 6, 9, 6, 4, 6, 7, 5, 6, 6, 7, 5, 5, 9, 7, 5, 6, 7,…
$ CONACTCON2 <dbl> 2, 1, 1, 1, 1, 2, 2, 2, 1, 2, 2, 2, 1, 1, 9, 9, 1, 2, 1, 1,…
$ SITLABCON2 <dbl> 2, 1, 1, 1, 1, 2, 3, 3, 1, 2, 3, 2, 1, 1, 9, 9, 1, 3, 1, 1,…
$ POSTRACON2 <dbl> 9, 2, 2, 2, 9, 9, 9, 9, 2, 9, 9, 9, 1, 2, 9, 9, 2, 9, 1, 2,…
$ TIPO_CON <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…Hay un total de 20000 registros de matrimonios en nuestra población.
Tomando una muestra
set.seed(123)
N <- nrow(datos)
n <- 2000
fact_exp <- N / n
z <- qnorm(0.975)
muestra <- datos |> sample_n(size = n)2. Matrimonios por entidad
- \(N\) = Tamaño de población total \(20,000\)
- \(n\) = Tamaño de muestra \(2,000\)
- \(N_d\) = Número total de matrimonios en la entidad \(d\).
- \(z_{0.975}=1.96\)
Para esto usamos el \(\text{Factor de expansión} = \frac{N}{n}\). De aquí:
\[ N_d = \frac{N}{n} n_d \]
De aquí, calculamos la proporción por entidad con
\[ \hat{P}_d = n_d / n \]
para estimar el total de un dominio (o una característica)
\[ \hat{N}_d=N \hat{P}_d \]
y su varianza:
\[ V(\hat{N}_d)=N^2V(\hat{P_d}) \]
y la precisión
\[ z_{0.975} \cdot \sqrt{N^2\left(1 - \frac{n}{N}\right)\frac{\hat{P}_d \cdot (1 - \hat{P}_d)}{n}} \]
calcular_estimar_matrimonios <-
function(
datos,
columna,
columna_etiqueta,
N,
titulo_grafico,
usa_entidades = FALSE
) {
n <- nrow(datos)
matrimonios_por_columna_muestra <- table(datos[[columna]])
matrimonios_por_columna_poblacion <- matrimonios_por_columna_muestra * fact_exp
proporcion_por_columna <- matrimonios_por_columna_muestra / n
SE_por_columna <- sqrt((N ^ 2)* (1 - n / N) * proporcion_por_columna * (1 - proporcion_por_columna) / (n - 1))
z <- qnorm(0.975)
IC_lower <- matrimonios_por_columna_poblacion - z * SE_por_columna
IC_upper <- matrimonios_por_columna_poblacion + z * SE_por_columna
# Crear un data frame con las estimaciones puntuales y los intervalos de confianza
datos_grafico <- data.frame(
var = names(matrimonios_por_columna_poblacion),
estimacion = as.numeric(matrimonios_por_columna_poblacion),
IC_lower = as.numeric(IC_lower),
IC_upper = as.numeric(IC_upper)
)
if (usa_entidades) {
datos_grafico <- data.frame(
nombre_entidad = names(matrimonios_por_columna_poblacion),
estimacion = as.numeric(matrimonios_por_columna_poblacion),
IC_lower = as.numeric(IC_lower),
IC_upper = as.numeric(IC_upper)
) |> left_join(nombres_entidades)
names(datos_grafico)[ncol(datos_grafico)] <- "var"
}
# Crear el gráfico
grafico <- ggplot(datos_grafico, aes(x = reorder(var, -estimacion), y = estimacion)) +
geom_point(color = "steelblue") +
geom_errorbar(aes(ymin = IC_lower, ymax = IC_upper), width = 0.2) +
labs(
title = titulo_grafico,
subtitle = "Intervalo de confianza del 95%",
y = "Estimación Puntual de Matrimonios",
x = ""
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Crear la tabla
tabla <- datos_grafico |>
select(var, estimacion, IC_lower, IC_upper) |>
gt() |>
tab_header(
title = "Estimación de matrimonios por entidad",
subtitle = "Con intervalos de confianza al 95%"
) |>
fmt_number(
columns = c("estimacion", "IC_lower", "IC_upper"),
decimals = 0
) |>
cols_label(
var = columna_etiqueta,
estimacion = "Estimación Puntual",
IC_lower = "Límite Inferior",
IC_upper = "Límite Superior"
) |>
tab_source_note(
source_note = "Datos de una muestra aleatoria simple de n=2000."
)
# Devolver ambos en una lista
return(list(grafico = grafico, tabla = tabla))
}
resultados <- calcular_estimar_matrimonios(
datos = muestra,
columna = "ENT_REGIS",
columna_etiqueta = "Entidades Federativas",
N = N,
titulo_grafico = "Estimación de Matrimonios por Entidad"
)
resultados$grafico
resultados$tabla| Estimación de matrimonios por entidad | |||
|---|---|---|---|
| Con intervalos de confianza al 95% | |||
| Entidades Federativas | Estimación Puntual | Límite Inferior | Límite Superior |
| 01 | 270 | 174 | 366 |
| 02 | 590 | 449 | 731 |
| 03 | 130 | 63 | 197 |
| 04 | 170 | 94 | 246 |
| 05 | 680 | 529 | 831 |
| 06 | 150 | 78 | 222 |
| 07 | 900 | 728 | 1,072 |
| 08 | 580 | 440 | 720 |
| 09 | 1,030 | 846 | 1,214 |
| 10 | 260 | 166 | 354 |
| 11 | 1,290 | 1,086 | 1,494 |
| 12 | 700 | 547 | 853 |
| 13 | 440 | 318 | 562 |
| 14 | 1,530 | 1,309 | 1,751 |
| 15 | 2,630 | 2,349 | 2,911 |
| 16 | 730 | 574 | 886 |
| 17 | 370 | 258 | 482 |
| 18 | 170 | 94 | 246 |
| 19 | 990 | 810 | 1,170 |
| 20 | 590 | 449 | 731 |
| 21 | 850 | 682 | 1,018 |
| 22 | 250 | 158 | 342 |
| 23 | 420 | 301 | 539 |
| 24 | 540 | 405 | 675 |
| 25 | 530 | 396 | 664 |
| 26 | 560 | 423 | 697 |
| 27 | 320 | 216 | 424 |
| 28 | 510 | 379 | 641 |
| 29 | 200 | 117 | 283 |
| 30 | 1,060 | 874 | 1,246 |
| 31 | 310 | 207 | 413 |
| 32 | 250 | 158 | 342 |
| Datos de una muestra aleatoria simple de n=2000. | |||
3. Matrimonios por mes
resultados_mes <- calcular_estimar_matrimonios(
datos = muestra,
columna = "MES_REGIS",
columna_etiqueta = "Mes",
N = N,
titulo_grafico = "Estimación de Matrimonios por mes"
)resultados_mes$grafico
resultados_mes$tabla| Estimación de matrimonios por entidad | |||
|---|---|---|---|
| Con intervalos de confianza al 95% | |||
| Mes | Estimación Puntual | Límite Inferior | Límite Superior |
| 1 | 1,410 | 1,197 | 1,623 |
| 2 | 2,980 | 2,684 | 3,276 |
| 3 | 1,840 | 1,600 | 2,080 |
| 4 | 1,240 | 1,039 | 1,441 |
| 5 | 1,670 | 1,440 | 1,900 |
| 6 | 1,390 | 1,178 | 1,602 |
| 7 | 1,350 | 1,141 | 1,559 |
| 8 | 1,700 | 1,468 | 1,932 |
| 9 | 1,080 | 892 | 1,268 |
| 10 | 1,660 | 1,431 | 1,889 |
| 11 | 1,490 | 1,272 | 1,708 |
| 12 | 2,190 | 1,930 | 2,450 |
| Datos de una muestra aleatoria simple de n=2000. | |||
7. Matrimonios por mes por entidad
genera_resultados_sin_grupo <- function(datos, titulo_grafico, titulo_tabla = titulo_grafico) {
n_d <- nrow(datos)
prop <- n_d / n
SE <- sqrt((N ^ 2) * (1 - n / N) * prop * (1 - prop) / (n - 1))
z <- qnorm(0.975)
IC_lower <- N * prop - z * SE
IC_upper <- N * prop + z * SE
datos_grafico <- data.frame(
var = "Matrimonios",
estimacion = prop * N,
IC_lower = round(IC_lower, 0),
IC_upper = round(IC_upper, 0)
)
tabla <- datos_grafico |>
gt() |>
tab_header(
title = titulo_grafico,
subtitle = "Con intervalo de confianza al 95%"
) |>
fmt_number(
columns = c("estimacion", "IC_lower", "IC_upper"),
decimals = 0
) |>
cols_label(
var = "",
estimacion = "Estimación Puntual",
IC_lower = "Límite Inferior",
IC_upper = "Límite Superior"
) |>
tab_source_note(
source_note = "Datos de una muestra aleatoria simple de n=2,000."
)
grafico <- ggplot(datos_grafico, aes(x = var, y = estimacion)) +
geom_point(color = "steelblue") +
geom_errorbar(aes(ymin = IC_lower, ymax = IC_upper), width = 0.2) +
labs(
title = titulo_tabla,
subtitle = "Intervalo de confianza del 95%",
y = "Estimación Puntual de Matrimonios",
x = ""
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
list(tabla = tabla, grafico = grafico)
}
resultados <- genera_resultados_sin_grupo(
muestra |> filter(SEXO_CON1 == 1, SEXO_CON2 == 1),
"Estimación de matrimonios del mismo sexo (hombres)",
"Estimación de matrimonios del mismo sexo (hombres)"
)
resultados$grafico
resultados$tabla| Estimación de matrimonios del mismo sexo (hombres) | |||
|---|---|---|---|
| Con intervalo de confianza al 95% | |||
| Estimación Puntual | Límite Inferior | Límite Superior | |
| Matrimonios | 60 | 15 | 105 |
| Datos de una muestra aleatoria simple de n=2,000. | |||
8. Proporción de matrimonios con contrayentes del mismo sexo por entidad federativa.
mismo_sex_ent <- muestra |>
filter(SEXO_CON1 == SEXO_CON2) |>
group_by(ENT_REGIS) |>
summarise(estimacion = n() / n) |>
rename(entidad = ENT_REGIS) |>
left_join(nombres_entidades)
est_ic <- function(p, lower = TRUE) {
se <- z * sqrt((1 - n / N) * (p * (1 - p) / (n - 1)))
if (lower) return(p - se)
p + se
}
datos_grafico <- mismo_sex_ent |>
mutate(
IC_lower = est_ic(estimacion),
IC_upper = est_ic(estimacion, lower = FALSE)
)
datos_grafico |>
select(nombre_entidad, estimacion, IC_lower, IC_upper) |>
gt() |>
tab_header(
title = "Proporción de matrimonios del mismo sexo por entidad federativa",
subtitle = "Con intervalo de confianza al 95%"
) |>
fmt_number(
columns = c("nombre_entidad", "estimacion", "IC_lower", "IC_upper"),
decimals = 5
) |>
cols_label(
nombre_entidad = "Entidad Federativa",
estimacion = "Estimación Puntual",
IC_lower = "Límite Inferior",
IC_upper = "Límite Superior"
) |>
tab_source_note(
source_note = "Datos de una muestra aleatoria simple de n=2,000."
)| Proporción de matrimonios del mismo sexo por entidad federativa | |||
|---|---|---|---|
| Con intervalo de confianza al 95% | |||
| Entidad Federativa | Estimación Puntual | Límite Inferior | Límite Superior |
| Coahuila de Zaragoza | 0.00100 | −0.00031 | 0.00231 |
| Chihuahua | 0.00100 | −0.00031 | 0.00231 |
| Ciudad de México | 0.00350 | 0.00104 | 0.00596 |
| Jalisco | 0.00050 | −0.00043 | 0.00143 |
| Morelos | 0.00050 | −0.00043 | 0.00143 |
| Datos de una muestra aleatoria simple de n=2,000. | |||
ggplot(
datos_grafico,
aes(x = reorder(nombre_entidad, -estimacion), y = estimacion)
) +
geom_point(color = "steelblue") +
geom_errorbar(aes(ymin = IC_lower, ymax = IC_upper), width = 0.2) +
labs(
title = "Proporción matrimonios mismo sexo por entidad federativa",
subtitle = "Intervalo de confianza del 95%",
y = "Estimación Puntual de Matrimonios",
x = ""
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
9. Matrimonios entre mexicanos
resultados <- genera_resultados_sin_grupo(
muestra |> filter(NACI_CON1 == 1, NACI_CON2 == 1),
"Matrimonios entre mexicanos",
"Estimación de matrimonios entre mexicanos"
)
resultados$grafico
resultados$tabla| Matrimonios entre mexicanos | |||
|---|---|---|---|
| Con intervalo de confianza al 95% | |||
| Estimación Puntual | Límite Inferior | Límite Superior | |
| Matrimonios | 19,090 | 18,917 | 19,263 |
| Datos de una muestra aleatoria simple de n=2,000. | |||
10. Matrimonios entre extranjeros
resultados <- genera_resultados_sin_grupo(
muestra |> filter(NACI_CON1 == 2, NACI_CON2 == 2),
"Matrimonios entre extranjeros"
)
resultados$grafico
resultados$tabla| Matrimonios entre extranjeros | |||
|---|---|---|---|
| Con intervalo de confianza al 95% | |||
| Estimación Puntual | Límite Inferior | Límite Superior | |
| Matrimonios | 280 | 182 | 378 |
| Datos de una muestra aleatoria simple de n=2,000. | |||
11. Matrimonios de mexicanos con extranjeros
mex_con_extranjero_1 <- filter(muestra, NACI_CON1 == 1, NACI_CON2 == 2)
mex_con_extranjero_2 <- filter(muestra, NACI_CON1 == 2, NACI_CON2 == 1)
mex_con_extranjero <- mex_con_extranjero_1 |> bind_rows(mex_con_extranjero_2)
resultados <- genera_resultados_sin_grupo(
mex_con_extranjero,
"Matrimonios entre mexicano con extranjeros"
)
resultados$grafico
resultados$tabla| Matrimonios entre mexicano con extranjeros | |||
|---|---|---|---|
| Con intervalo de confianza al 95% | |||
| Estimación Puntual | Límite Inferior | Límite Superior | |
| Matrimonios | 630 | 485 | 775 |
| Datos de una muestra aleatoria simple de n=2,000. | |||