Proyecto final Teoría y técnicas de muestreo
Jonathan Rougier
2024-01-02
Planteo del problema
Se desea estimar la proporción de votantes a FdT, JxC y FIT (a diputados nacionales) a nivel nacional respecto al total de votos válidos para las elecciones de 14 Noviembre 2021 mediante una muestra aleatoria de tamaño total aproximado de n=480 mesas, mediante muestreo por conglomerado bietápico. El marco de muestreo se construirá a partir de la tabla MESAS ESCRUTADAS Cierre.csv (tablas publicadas por la DNE).
• Unidades de primera etapa: distrito electoral. Estratificadas por Zona: CABA, BsAs, NEA-NOA, Resto. Asignación de la muestra proporcional a los votos válidos del estrato. Se seleccionan n=80 circuitos en total. Forzar a que haya el menos dos circuitos seleccionados por estrato
• Unidades de segunda etapa: mesa electoral. Se seleccionan, mediante MAS, m=6 mesas en cada circuito seleccionado , o todas de haber menos.
• Las unidades der primera etapa se seleccionan dentro de cada estrato mediante Madow, con probabilidad de selección proporcional a la cantidad de mesas del circuito. Ordenando por Provincia-Sección.
• Las unidades de segunda etapa se seleccionan mediante MAS
Preparación de los datos
Para llevar adelante la muestra levantamos la base de mesas escrutadas que servirá como marco muestral. La misma será editada para poder elaborar el marco. Por lo tanto, filtraremos sólo quedándonos con los votos positivos y para diputados nacionales.
#Levantamos la base de mesas escrutadas
library(readxl)
marco.mesas<- "C:\\Users\\cti23835\\Desktop\\Teorías y técnicas de muestreo\\Unidad 3\\MESAS_ESCRUTADAS_Cierre.csv"
marco.mesas<- read.csv(marco.mesas, sep=",")#Llamamos las librerías
library(dplyr)
library(tidyverse)
#Removemos los votos no positivos
marco.mesas.validos<- marco.mesas %>% filter(tipoVoto == "positivo" & Cargo =="DIPUTADOS NACIONALES")Para calcular el total de votos del Frente de Todos, Juntos por el cambio y Frente de Izquierda recodificamos todos los partidos que formaron parte de los frentes. Para la recodificación se tomó como referencia los datos provenientes de wikipedia
#Primero recodificamos las alianzas de los frentes
#Frente Junto por el cambio: Incluye Juntos por el cambio, juntos, Frente cambia Mendoza, Juntos por Entre Rios, ECO + Vamos corrientes,
#Chaco Cambia + Juntos por el cambio, Frente Cambia Jujuy,
#Juntos por el cambio +, Juntos por Formosa Libre, Unidos por San Luis,
#Juntos por cambio Chubut, Cambia Neuquen, Cambia Santa Cruz, Coalición Civica ARI,
#Vamos La Rioja, Juntos por el cambio Tierra del Fuego
#Union Civica Rádical, Unidos
marco.mesas.validos <- marco.mesas.validos %>% mutate(JXC = case_when( Agrupacion == "JUNTOS POR EL CAMBIO" |
Agrupacion == "JUNTOS" |
Agrupacion == "CAMBIA MENDOZA"|
Agrupacion == "JUNTOS POR ENTRE RÍOS" |
Agrupacion == "ECO + VAMOS CORRIENTES"|
Agrupacion == "CHACO CAMBIA + JUNTOS POR EL CAMBIO" |
Agrupacion == "CAMBIA JUJUY"|
Agrupacion == "JUNTOS POR FORMOSA LIBRE"|
Agrupacion == "UNIDOS POR SAN LUIS"|
Agrupacion == "JUNTOS POR EL CAMBIO CHUBUT"|
Agrupacion == "CAMBIA NEUQUÉN"|
Agrupacion == "CAMBIA SANTA CRUZ"|
Agrupacion == "COALICIÓN CÍVICA - AFIRMACIÓN PARA UNA REPÚBLICA IGUALITARIA (ARI)"|
Agrupacion == "VAMOS LA RIOJA"|
Agrupacion == "JUNTOS POR EL CAMBIO TIERRA DEL FUEGO"|
Agrupacion == "UNIÓN CÍVICA RADICAL"|
Agrupacion == "UNIDOS" ~ "JXC",
TRUE ~ "RESTO"))
#Frente de Frente de todos
marco.mesas.validos<- marco.mesas.validos %>% mutate(FdT = case_when( Agrupacion == "FRENTE DE TODOS" |
Agrupacion == "FRENTE CIVICO POR SANTIAGO" |
Agrupacion == "FUERZA SAN LUIS" |
Agrupacion == "FRENTE RENOVADOR" |
Agrupacion == "COMPROMISO FEDERAL" |
Agrupacion == "TODOS UNIDOS" ~ "Fdt",
TRUE ~ "RESTO"))
#Alianza del FIT
#Incluye Frente de izquierda y de trabajadores-Unidad, Partido del Obrero, Nueva Izquierda, Partido obrero
marco.mesas.validos<- marco.mesas.validos %>% mutate(FIT = case_when(Agrupacion =="FRENTE DE IZQUIERDA Y DE TRABAJADORES - UNIDAD" |
Agrupacion =="DEL OBRERO" |
Agrupacion =="NUEVA IZQUIERDA" |
Agrupacion =="OBRERO" ~ "FIT",
TRUE ~ "RESTO"))#Creamos una variables que levante todos los partidos de las variables recodificadas
marco.mesas.validos<- marco.mesas.validos %>% mutate(Partidos=case_when( FdT == "Fdt" ~ "Fdt",
FIT == "FIT" ~ "FIT",
JXC == "JXC" ~ "JXC",
TRUE ~ "OTRO"))#Creamos una variable de identificación concatenando los valores de IdCircuito, IdDistrito, IdSeccion, Mesa
marco.mesas.validos$CODIGOMESA <- paste( marco.mesas.validos$IdCircuito, marco.mesas.validos$IdDistrito, marco.mesas.validos$IdSeccion, marco.mesas.validos$Mesa)
#Nos quedamos con las variables que necesitamos
marco.mesas.validos<- marco.mesas.validos %>% select(CODIGOMESA, Distrito, IdDistrito, Establecimiento, Codigo, Mesa, electores, votos, Partidos, IdCircuito)La muestra será estratificada por zona. Para ello, tomaremos la variable Distrito y recategorizaremos en 4 zonas. Norte Argentino (NOA + NEA), Buenos Aires sin CABA, Ciudad autónoma de Buenos Aires y el Resto del país.
#Revisamos las etiquetas de los distritos y los recategorizamos para dividirlos por zona (NOA+NEA, CABA, Buenos Aires, RESTO)
#Esta es la variable que luego utilizaremos para estratificar
marco.mesas.validos <- marco.mesas.validos %>% mutate(Zona= case_when(Distrito =="Jujuy" | Distrito == "Salta" | Distrito == "Tucumán"| Distrito == "Catamarca" | Distrito == "La Rioja" | Distrito == "Santiago del Estero" | Distrito == "Formosa" | Distrito == "Chaco" | Distrito == "Corrientes" | Distrito == "Misiones" ~ "NEA-NOA",
Distrito == "Ciudad Autónoma de Buenos Aires" ~ "Ciudad Autónoma de Buenos Aires",
Distrito == "Buenos Aires" ~ "Buenos Aires",
TRUE ~ "RESTO")) #Creamos el marco muestral
marco.muestral<- pivot_wider(data = marco.mesas.validos, id_cols = CODIGOMESA, names_from = Partidos ,values_from = votos, values_fn = sum)
#Transformamos los NA en 0
marco.muestral[is.na(marco.muestral)] <- 0
#Sumamos la columna de total de votos por mesa al marco muestral
marco.muestral<- marco.muestral %>% mutate(TOTALVOT = FIT + Fdt + JXC + OTRO)
#Al marco muestral le sumamos las variables de Distrito = Provincia, Zona = variable de estratificación, IdCircuitos, Establecimiento = Codigo, Mesa
marco.mesas.validos.sin.voto<- marco.mesas.validos %>% select(CODIGOMESA,Zona, Distrito,IdCircuito,Establecimiento, Codigo, Mesa)
marco.muestral.vf<- left_join(marco.muestral, marco.mesas.validos.sin.voto,by= "CODIGOMESA") %>% unique()
######Ya tenemos armado el marco muestralSolución de las consignas
1. Presentar en una tabla los circuitos a seleccionar por estrato de primera etapa
Creado nuestro marco muestral, procedemos a generar la tabla de circuitos de la cual se seleccionarán las unidades de la primera etapa. Para la primera etapa de selección se tomará n= 80. La tabla circuitos tendrá un código de identificación que permita dar cuenta de la Zona y el Id del Circuito del cual se extrae la unidad de la primera etapa. También incorporará las probabilidades de selección de cada una de ellas.
# Ahora debemos calcular total de Circuitos por estrato (fpc1)
# y la cantidad de mesas de cada Circuito (fpc2)
# Lo agregamos a la tabla de alumnos ya que luego lo necesitaremos para correr survey
#En la primera etapa tenemos que seleccionar 80 circuitos
n= 80
#Calculo la cantidad de mesas por circuito en cada zona
tabla.circuitos <- marco.muestral.vf %>% group_by(Zona, IdCircuito) %>% summarise(Mi=n())## `summarise()` has grouped output by 'Zona'. You can override using the
## `.groups` argument.tabla.circuitos$ID<- paste(tabla.circuitos$Zona, tabla.circuitos$IdCircuito)
#Calculo el tamaño de los estratos
#El peso de cada uno segun su cantidad de mesas
#y la probabilidad de selección para cada circuito
tabla.estratos<- tabla.circuitos %>% group_by(Zona) %>% summarise(Nh=n(), Mh=sum(Mi)) %>% mutate(nh=round(n*Nh/nrow(tabla.circuitos)))A partir de la transformacion del marco muestral tenemos 3059 circuitos y 100237 mesas.
sum(tabla.estratos$Nh) #Tengo 3059 circuitos## [1] 3059sum(tabla.estratos$Mh) #Tengo 100237 mesas## [1] 100237#Revisamos la asignacion
sum(tabla.estratos$nh) #Tengo la asignación proporcional a la cantidad de mesas por estrato utilizando n= 80## [1] 80Calculamos la cantidad de circuitos y mesas totales correspondientes a cada estrato. Tambien calculamos la cantidad de muestras a obtener en cada estrato para la primera etapa de muestreo.
#Revisamos la tabla
tabla.estratos#Una vez obtenido el valor de nh y Mh
#En la tabla circuitos agregamos nh y Mh como valores nulos
tabla.circuitos$nh <- NULL
tabla.circuitos$Mh <- NULL
#Una vez asignados los valores podemos levantar los campos de la tabla estratos a ser unidos
#en la tabla de circuitos
tabla.circuitos <- merge(tabla.circuitos, tabla.estratos[,c("Zona", "nh", "Mh")], by="Zona")
#Calculamos la probabilidad de inclusión de la primera etapa (PIK)
tabla.circuitos$pik <- tabla.circuitos$nh * tabla.circuitos$Mi / tabla.circuitos$Mh
sum(tabla.circuitos$pik)## [1] 80#Ahora procedemos a seleccionar la muestra
tabla.estratos<- tabla.estratos[order(tabla.estratos$Zona),]
tabla.circuitos <- tabla.circuitos[order(tabla.circuitos$Zona),]
tabla.circuitos2. Seleccionar con sampling una muestra
Para seleccionar las muestras de la primera etapa estratificamos por zona con un tamaño de muestra por estrato de acuerdo a los valores obtenidos(nh) en la tabla estrato. El muestreo se realizará mediante sistemático de Madow.
#Cargamos la libreria de sampling
library(sampling)## Warning: package 'sampling' was built under R version 4.2.3#Realizamos el muestreo de la primera etapa de selección mediante sistemático de Madow
set.seed(1234)
muestra.circuitos<- sampling::strata(tabla.circuitos, stratanames = "Zona", size = tabla.estratos$nh,
pik=tabla.circuitos$pik,
method = "systematic")
#Levantamos los circuitos obtenidos del muestreo sistematico de la primera etapa
muestra.circuitos<- getdata(tabla.circuitos,muestra.circuitos)
#Calculamos la probabilidad de la primera etapa
muestra.circuitos$F1 <- 1/muestra.circuitos$Probmuestra.circuitosObtenida las unidades de la primera etapa de selección, realizamos la segunda etapa de selección.
#Comenzamos con la segunda etapa de selección
#unimos las variables de clasificacion de la primera etapa para crear el marco muestral
marco.muestral.vf$ID <- paste(marco.muestral.vf$Zona, marco.muestral.vf$IdCircuito)
tabla.mesa <- merge(marco.muestral.vf, muestra.circuitos[,c("ID","Mi", "F1")], by= "ID")#Ordenamos la tabla por zona
tabla.mesa[order(tabla.mesa$Zona),]Al igual que con las unidades de la primera etapa, calculamos la probabilidad de selección de cada una de las unidades de segunda etapa.
#Creamos la tabla estrato 2 con seleccion de n= 6 mesas por circuito y
#la cantidad de mesas promedio por circuito Mi para luego calcular las probabilidad de seleccion
m=6
tabla.estratos2 <- tabla.mesa %>% group_by(ID) %>% summarise(nh=m, Mi=mean(Mi))
#Si la cantidad de mesas es menor a 6 asignamos el valor maximo de cantidad de meses
tabla.estratos2$nh <- ifelse(tabla.estratos2$nh <=tabla.estratos2$Mi,
tabla.estratos2$nh, tabla.estratos2$Mi)
tabla.estratos2Calculada la probabilidad de selección de las unidades, procedemos a extraer las muestra correspondientes a la segunda etapa mediante muestreo aleatorio simple.
#Seleccionamos la muestra aleatoria de meses
set.seed(1234)
muestra.mesas<- sampling::strata(data=tabla.mesa, stratanames = "ID", size = tabla.estratos2$nh, method = "srswor")
#Seleccionamos la muestra
muestra.mesas.final<- getdata(tabla.mesa, muestra.mesas)
muestra.mesas.finalObtenemos una muestra final de n= 471 mesas.
#Una vez obtenida la muestra final podemos asignar la probabilidad de seleccion
muestra.mesas.final$F2 <- 1/muestra.mesas.final$Prob
#Generamos la variable de ponderación para el muestreo bietapico
muestra.mesas.final$pondera <- muestra.mesas.final$F1 * muestra.mesas.final$F2
muestra.mesas.final3. Calcular con survey las tres estimaciones buscadas, junto a sus CV, IC(95%) y deff. Los IC contienen a los parámetros?
Una vez obtenida la muestra podemos asignar el diseño de la misma utilizando el paquete survey.
#Procedemos a declarar el diseño
library(survey)
diseno<- svydesign(~ID, strata = ~Zona, weights = ~pondera, data=muestra.mesas.final)#Estimamos de la proporcion de votos para el Fdt
Porc.FDT <- survey :: svyratio(~ Fdt , ~TOTALVOT, diseno, deff=TRUE )
df_ratio <- data.frame(Porc.FDT[[1]])
df_SE <- data.frame( sqrt(Porc.FDT[[2]]))
CV <- survey::cv(Porc.FDT)
df_proporcion.Fdt <- cbind(df_ratio, df_SE)
df_proporcion.Fdt$CV <- 100*CV[1,1]
df_proporcion.Fdt$deff <- survey::deff(Porc.FDT)
IC<- confint(Porc.FDT, level = .95) %>% as.data.frame()
df_proporcion.Fdt<- cbind(df_proporcion.Fdt, IC)
colnames(df_proporcion.Fdt) <- c("Proporción", "SE", "CV", "deff", "L.i. con 95% de Conf", "L.S con 95% conf")
#df_proporcion.Fdt
#Estimamos de la proporcion de votos para el FIT
Porc.FIT <- survey :: svyratio(~ FIT , ~TOTALVOT, diseno, deff=TRUE )
df_ratio <- data.frame(Porc.FIT[[1]])
df_SE <- data.frame( sqrt(Porc.FIT[[2]]))
CV <- survey::cv(Porc.FIT)
df_proporcion.FIT <- cbind(df_ratio, df_SE)
df_proporcion.FIT $CV <- 100*CV[1,1]
df_proporcion.FIT $deff <- survey::deff(Porc.FIT)
IC<- confint(Porc.FIT, level = .95) %>% as.data.frame()
df_proporcion.FIT<- cbind(df_proporcion.FIT, IC)
colnames(df_proporcion.FIT) <- c("Proporción", "SE", "CV", "deff", "L.i. con 95% de Conf", "L.S con 95% conf")
#df_proporcion.FIT
#Estimamos de la proporcion de votos para el JXC
Porc.JXC <- survey :: svyratio(~ JXC , ~TOTALVOT, diseno, deff=TRUE )
df_ratio <- data.frame(Porc.JXC[[1]])
df_SE <- data.frame( sqrt(Porc.JXC[[2]]))
CV <- survey::cv(Porc.JXC)
df_proporcion.JXC <- cbind(df_ratio, df_SE)
df_proporcion.JXC $CV <- 100*CV[1,1]
df_proporcion.JXC $deff <- survey::deff(Porc.JXC)
IC<- confint(Porc.JXC, level = .95) %>% as.data.frame()
df_proporcion.JXC<- cbind(df_proporcion.JXC, IC)
colnames(df_proporcion.JXC) <- c("Proporción", "SE", "CV", "deff", "L.i. con 95% de Conf", "L.S con 95% conf")
#df_proporcion.JXCCon un 95% de confianza podemos decir el parametro de votos de Juntos por el Cambio se encontraría entre 36,19% y 41,20%. El parametro del Frente de Todos entre 31,05% y 35,50%. El del Frente de Izquierda entre 0,48% y el 0,57%.
#Generamos una tabla con las tres estimaciones
estimacion<- rbind(df_proporcion.JXC,df_proporcion.Fdt,df_proporcion.FIT)
estimacion #Los IC contienen los parametros. Ver debajoAl revisar los parametros poblacionales, vemos que los mismos están contenidos en los intervalos de confianza de los estimadores.
#Revisamos los parametros
#Parametro de votos de Juntos por el cambio
sum(marco.muestral.vf$JXC)/sum(marco.muestral.vf$TOTALVOT)## [1] 0.3832447#Parametros de votos del Frente de Todos
sum(marco.muestral.vf$Fdt)/sum(marco.muestral.vf$TOTALVOT)## [1] 0.3314543#Parametros de votos del Frente de Izquierda
sum(marco.muestral.vf$FIT)/sum(marco.muestral.vf$TOTALVOT)## [1] 0.054402454. Con ese diseño podemos (con un 95% de confianza) detectar quien gana la elección?. Si no, que tamaño aproximado de circuitos necesitaríamos? (se puede probar con algunos tamaños), Una respuesta rápida puede ser buscando un n de circuitos que haga que los intervalos IC(95%) no se corten. Algo más ajustado es un test de medias.
Con el diseño actual podemos decir que Juntos por el Cambio ganará las elecciones. Con un 95% de confianza el límite inferio de la estimación de Juntos por el Cambio no se toca con el límite superior de la estimación del Frente de Todos. Por lo tanto, podemos asegurar el triunfo de JXC. Si quisieramos, podríamos realizar un test de proporciones como se detalla debajo.
#Test de proporciones
prop.test(x=c(42608 ,36712 ), n=c(110391,110391), alternative="two.side", conf.level=0.95, correct=FALSE)##
## 2-sample test for equality of proportions without continuity correction
##
## data: c(42608, 36712) out of c(110391, 110391)
## X-squared = 684, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## 0.04941374 0.05740656
## sample estimates:
## prop 1 prop 2
## 0.3859735 0.3325633#Se puede asegurar que JXC gana la elección5. En base a los resultados, qué propondría para mejorar el diseño, manteniendo la cantidad total de mesas?
Si quisieramos mejorar el diseño sin cambiar la cantidad total de mesas podríamos estratificar la muestra en más zonas. En lugar de estratificar en 4 zonas, podríamos estratificar en 6 zonas. Por ejemplo, NOA por un lado, NEA por otro lado, Patagonia, Cuyo, Buenos Aires y CABA.De esa manera, reduciríamos la varianza del estimador manteniendo la misma cantidad total de mesas
En caso de que quisieramos cambiar la cantidad de mesas, podríamos llegar al mismo resultado de Juntos por el Cambio realizando un MAS de tamaño 2,6 veces menor.
#Con un MAS DE tamaño 2.585947 menor hubiera obtenido la misma eficiencia
#LO comprobamos debajo
muestra.mas<- sampling::strata(data=marco.muestral.vf, size = 181, method = "srswor")
muestra.mas<- getdata(marco.muestral.vf,muestra.mas)
muestra.mas$pondera <- 1/muestra.mas$Prob
diseno.mas<- svydesign(~1, weights = ~pondera, data=muestra.mas)
Porc.JXC.mas <- survey :: svyratio(~ JXC , ~TOTALVOT, diseno.mas, deff=TRUE )
Porc.JXC.mas## Ratio estimator: svyratio.survey.design2(~JXC, ~TOTALVOT, diseno.mas, deff = TRUE)
## Ratios=
## TOTALVOT
## JXC 0.3821927
## SEs=
## TOTALVOT
## JXC 0.014460186. Calcular algunos índices de homogeneidad de los circuitos como clusters de mesas electorales, tomando como variables % de voto a FdT, Juntos y FIT.
##########################################################
# Estimacion de la homogeneidad de conglomerados
# Utilizamos el paquete fishmethods
marco.estima.ho<- marco.muestral.vf %>% group_by(Zona,IdCircuito) %>% mutate(Mi=n())
# Defino un data frame vacio para empezar
rho <- data.frame(row.names = c("Lohr rho", "Adjusted r-square", "ANOVA rho"))
# La variable cuya homogeneidad deseo calcular debe ser numerica
for(i in c("JXC", "Fdt", "FIT")){
rho[[i]] <- fishmethods::clus.rho(popchar=marco.estima.ho[[i]] ,
cluster = marco.estima.ho$ID,
type = c(1,2,3), est = 0, nboot = 500)[[1]][,1]
}
rho#La homogeneidad de los clusters es buena ya que se acerca a uno para cada una de las estimaciones.