Este análisis se realiza en el contexto del módulo “Geoestadística” del curso de FLACSO “Big Data e Inteligencia Territorial”. El objetivo es explorar la relación entre los votos obtenidos por los distintos partidos y el promedio del estrato socioeconómico de cada uno de los circuitos. Se utilizarán dos fuentes de datos: los resultados provisorios (provenientes de la dirección nacional electoral) y una clasificación de estrato socioeconómico por radio censal en base a los resultados del censo 2010 (disponible aquí y construída por el Pablo De Grande y Agustín Salvia)1. Se aplicará una regresión geográficamente ponderada para poder capturar las variaciones espaciales en la relación entre porcentaje de votos y nivel socioeconómico en cada circuito. Esto resulta fundamental en un país tan extenso como Argentina, para poder observar regiones sin que estén delimitadas por la organización administrativa de provincias, departamentos o municipios.
El trabajo está dividido en cuatro partes: procesamiento, análisis, modelado y discusión.
Hay dos procesamientos que no están incluídos en este trabajo pero es conveniente explicitar para entender las bases de datos. Por un lado, se realizó una serie de equivalencias con los resultados electorales para equipararlos con el shapefile de circuitos electorales de 2019. Para algunas provincias (Río Negro, San Luis, Tierra del Fuego) no fue posible generar esas equivalencias, por lo tanto se utiliza a nivel sección electoral. San Juan tiene una particularidad: sus circuitos no cubren la totalidad del terreno, sólo las partes con población. Por lo tanto, visualmente se ve “cortado” el mapa, pero es un efecto del archivo geográfico y no es faltante de información.
Por otro lado, inicialmente el estrato socioeconómico está a nivel radio censal y es una variable con 7 categorías: 1 para los radios censales de estratos socioeconómicos superiores, 7 para los radios censales de estratos socioeconómicos inferiores. Se realizó una equivalencia geográfica con el mapa de circuitos, para asignar cada radio a un circuito y luego se promediaron. Por lo tanto, el de NSE por circuito es un promedio de los estratos de los radios censales que están dentro. Decido utilizar esta fuente principalmente por dos motivos: primero, tiene un nivel de desagregación que nos permite trabajar a nivel de circuitos (a diferencia de los datos censales de 2022 que sólo están disponibles a nivel de sección); además, en términos relativos, la distribución de estratos socioeconómicos no debería haber tenido cambios abruptos. De todas formas, es un análisis interesante para replicar cuando se habilite la información censal del 2022.
Carguemos las librerías.
library(tidyverse) # librería para análisis general
library(readxl) # para trabajar con excel
library(grid) # para graficar dos mapas en el mismo gráfico
library(sf) # librería para datos geográficos
library(spdep) # operaciones espaciales
library(spgwr) # GWRLos resultados electorales ya fueron procesados, por lo que tomaré directamente el archivo ya unido con sus atributos espaciales. Están los resultados de las elecciones presidenciales entre 2019 y 2023. Se construye la variable de porcentaje de resultados afirmativos para La Libertad Avanza. Creamos una variable de región que nos va a servir luego.
# resultados históricos
df <- st_read('../bases/Resultados electorales - Nacional 2019 a 2023.geojson')Reading layer `Resultados electorales - Nacional 2019 a 2023' from data source
`C:\Users\Usuario\Documents\personal\curso big data e inteligencia territorial\bases\Resultados electorales - Nacional 2019 a 2023.geojson'
using driver `GeoJSON'
Simple feature collection with 5458 features and 103 fields (with 121 geometries empty)
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: -73.5635 ymin: -59.46319 xmax: -26.25208 ymax: -21.78266
Geodetic CRS: WGS 84df <- df %>%
# creo un ID para poder volver sobre las mismas geometrías después
mutate(ID = seq.int(nrow(df))) %>%
# obtenemos % de votos afirmativos, clave de circuito
mutate(lla_2023p_per = lla_2023p / afirmativos_2023p,
circuito_id = key_g19_shp) %>%
# creamos variable de región
mutate(region = case_when(Provincia %in% c("Córdoba", "Santa Fe", "Entre Ríos", "La Pampa") ~ "Centro",
Provincia %in% c("Mendoza", "San Juan", "San Luis") ~ "Cuyo",
Provincia %in% c("Chaco","Corrientes","Formosa","Misiones")~"NEA",
Provincia %in% c("Catamarca","Jujuy", "Salta", "La Rioja","Santiago del Estero", "Tucumán")~"NOA",
Provincia %in% c("Chubut","Río Negro", "Neuquén","Tierra del Fuego", "Santa Cruz")~"Patagonia",
Provincia %in% c("Buenos Aires","CABA")~"Buenos Aires"))
# vemos la estructura de la base
print(dim(df))[1] 5458 108df %>%
select(region, lla_2023p_per, circuito_id, Provincia, geometry) %>%
glimpse()Rows: 5,458
Columns: 5
$ region <chr> "Buenos Aires", "Buenos Aires", "Buenos Aires", "Buenos …
$ lla_2023p_per <dbl> 0.1625486, 0.1813317, 0.1708642, 0.1478010, 0.3286300, 0…
$ circuito_id <chr> "0100001", "0100002", "0100003", "0100004", "0100005", "…
$ Provincia <chr> "CABA", "CABA", "CABA", "CABA", "CABA", "CABA", "CABA", …
$ geometry <MULTIPOLYGON [°]> MULTIPOLYGON (((-58.3662 -3..., MULTIPOLYGO…# chequeamos resultados
df %>%
mutate(across(where(is.numeric), ~ replace_na(., 0))) %>%
as.data.frame() %>%
group_by(Provincia..filtro.) %>%
summarise(lla_2023p = sum(lla_2023p),
afirmativos = sum(afirmativos_2023p + blanco_2023p)) %>%
mutate(lla_2023p_per = lla_2023p/afirmativos,
lla_2023p_per = round(lla_2023p_per * 100,2)) %>%
arrange(desc(lla_2023p_per))# A tibble: 26 × 4
Provincia..filtro. lla_2023p afirmativos lla_2023p_per
<chr> <dbl> <dbl> <dbl>
1 Salta 318028 643413 49.4
2 San Luis 136800 286389 47.8
3 Mendoza 466437 1041054 44.8
4 Misiones 256295 597721 42.9
5 Jujuy 168200 422300 39.8
6 Chubut 124030 314737 39.4
7 Neuquén 156095 399663 39.1
8 Río Negro 147108 394687 37.3
9 La Rioja 69175 189256 36.6
10 Tucumán 325510 914476 35.6
# ℹ 16 more rowsSe crean archivos geográficos auxiliares para que el mapa se entienda mejor. Uno de provincias argentinas y otro de secciones electorales para el zoom en el Gran Buenos Aires. Luego, creamos una función para elaborar gráficos que reutilizaremos durante este trabajo.
sf_use_s2(FALSE)
df_prov <- st_read('bases/provincia.json') %>%
st_make_valid() %>%
st_crop(xmin = -75, xmax = -53, ymin = -55, ymax = -21)Reading layer `provincia' from data source
`C:\Users\Usuario\Documents\personal\curso big data e inteligencia territorial\analisis G2023\bases\provincia.json'
using driver `GeoJSON'
Simple feature collection with 24 features and 8 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: -74 ymin: -90 xmax: -25 ymax: -21.78086
Geodetic CRS: WGS 84df_gba_secc <- df %>%
filter(Provincia..filtro.%in% c("Buenos Aires (GBA)","CABA")) %>%
group_by(Sección.provincial) %>%
st_buffer(0.001) %>%
summarize(votos = sum(afirmativos_2023p))
f_map <- function(db, gba_db, variable,
titulo, leyenda,
paleta="divergente", facetado=FALSE){
gba_db <- db %>% filter(Provincia..filtro. %in% c("Buenos Aires (GBA)","CABA"))
main_map <- ggplot() +
geom_sf(data = db, aes_string(fill = variable), color = NA) +
geom_sf(data=df_prov, color='black', fill=NA)+
labs(title=titulo,
subtitle="Argentina - circuitos electorales",
fill=leyenda)+
theme_void()+
theme(legend.position = "bottom")
inset_map <- ggplot() +
geom_sf(data = gba_db, aes_string(fill = variable), color = NA) +
geom_sf(data=df_gba_secc, color='black', fill=NA)+
guides(fill="none")+
labs(title="GBA")+
theme_void() +
theme(plot.title = element_text(hjust = 0.5))
if (paleta=="viridis"){
main_map <- main_map + scale_fill_viridis_c()
inset_map <- inset_map + scale_fill_viridis_c()
}
if (paleta=="divergente") {
main_map <- main_map + scale_fill_gradient2(name=leyenda, low='blue',mid='white',high='red',midpoint=0)
inset_map <- inset_map + scale_fill_gradient2(name=leyenda, low='blue',mid='white',high='red',midpoint=0)
}
if (facetado==TRUE){
print("")
}
main_map +
annotation_custom(
grob = ggplotGrob(inset_map),
xmin = -67, xmax=-30, # ubicación en el primer mapa
ymin=-33, ymax=-53
)
}
titulo <- "% de Voto a La Libertad Avanza - PASO 2023"
leyenda <- "%"
f_map(db=df, titulo=titulo,leyenda=leyenda, variable="lla_2023p_per", paleta='viridis')
Se carga la base de estrato socioeconómico con una equivalencia de códigos para unirlo con nuestro archivo geográfico de resultados electorales.
cod <- read_csv('../bases/240222_INSUMOS_circuitos-electorales-equivalencias-shp-sf.csv') %>%
select(key_shapefile, distrito_sf, seccion_sf, circuito_sf) %>%
rename(circuito_id = key_shapefile) %>%
distinct()
nse <- read_excel('bases/NSE_circuito electoral.xlsx') %>%
rename(distrito_sf = distrito_electoral,
seccion_sf = seccion_electoral,
circuito_sf = circuito_electoral,
nse = promedio_segmento) %>%
select(-fuente) %>%
distinct()
nse <- nse %>%
left_join(cod, by=c("distrito_sf", "seccion_sf", "circuito_sf"))
dim(nse)[1] 5891 5nse %>%
ggplot()+
geom_density(aes(x=nse))+
labs(title='Distribución de NSE',
subtitle='1=NSE alto / 7=NSE bajo')+
theme_minimal()
Se realiza la unión con nuestra base de resultados electorales. Eliminamos los casos sin información de NSE: quedan así con 5789 circuitos. Para la elección PASO 2023 encontramos 240 circuitos sin dato.
nse <- nse %>%
select(circuito_id, nse)
df <- df %>%
left_join(nse, by=c("circuito_id")) %>%
drop_na(nse)
dim(df)[1] 5789 109df %>%
select(nse, lla_2023p_per) %>%
summary() nse lla_2023p_per geometry
Min. :1.067 Min. :0.00233 MULTIPOLYGON :5789
1st Qu.:4.439 1st Qu.:0.22726 epsg:4326 : 0
Median :5.370 Median :0.30831 +proj=long...: 0
Mean :5.270 Mean :0.31187
3rd Qu.:6.418 3rd Qu.:0.39406
Max. :7.000 Max. :1.00000
NA's :240 titulo <- "Estrato socioeconómico"
leyenda <- "NSE"
f_map(db=df, titulo=titulo,leyenda=leyenda, variable="nse", paleta='viridis')
Exploramos la relación lineal entre ambas variables. Si bien en la generalidad no hay una relación lineal, cuando se pone atención en las distintas regiones el coeficiente de correlación aumenta y sostiene significancia estadística.
df %>%
as.data.frame() %>% # para ignorar geometría
select(nse, lla_2023p_per, region) %>%
drop_na() %>%
mutate(region = case_when(region=="Buenos Aires"~"BA",
region=="Patagonia"~"PAT",
TRUE ~ region)) %>%
GGally::ggpairs(aes(alpha = 0.4, color=region),
lower = list (continuos = "points",
combo = "facetdensity",
discrete = "facetbar") ) +
theme_minimal()
Se realiza una transformación de las variables para asimilarlas mejor a una distribución normal y así contribuir con un mejor funcionamiento del modelo de regresión lineal (la normalidad de sus variables en parte de los supuestos). Al menos gráficamente no se aprecia una mejora sustantiva.
boxcox_trans <- df %>%
as.data.frame() %>% # para ignorar geometría
select(nse, lla_2023p_per) %>%
filter(lla_2023p_per > 0) %>%
select(where(is.numeric)) %>%
car::powerTransform()
(tr <- summary(boxcox_trans)[["result"]][ , "Rounded Pwr"]) nse lla_2023p_per
1.85 0.78 df <- df %>%
mutate(nse_tr = nse^tr[["nse"]],
lla_2023p_per_tr = lla_2023p_per^tr[["lla_2023p_per"]])
ggpubr::ggarrange(
df %>%
ggplot() +
geom_density(aes(nse), color = "tomato4" ) +
labs(title="NSE")+
theme_minimal(),
df %>%
ggplot() +
geom_density(aes(nse_tr), color = "tomato4" ) +
labs(title="NSE transformada")+
theme_minimal()
)
ggpubr::ggarrange(
df %>%
ggplot() +
geom_density(aes(lla_2023p_per), color = "tomato4" ) +
labs(title="LLA")+
theme_minimal(),
df %>%
ggplot() +
geom_density(aes(lla_2023p_per_tr), color = "tomato4" ) +
labs(title="LLA transformada")+
theme_minimal()
)
Veamos la relación de las variables en cada una de las provincias. Hay provincias como CABA, Buenos Aires (GBA), Mendoza o Santa Fe donde se ve una relación positiva (cuanto más pobreza, mayor voto a La Libertad Avanza). En lugares como Río Negro, Chaco, Entre Ríos se ve una relación negativa (cuanto mayor pobreza, menor voto a La Libertad Avanza).
df %>%
select(lla_2023p_per, nse, Provincia..filtro.) %>%
drop_na() %>%
ggplot(aes(x=nse, y=lla_2023p_per))+
geom_point()+
geom_smooth(method='lm')+
facet_wrap(~Provincia..filtro.) +
labs(title='Relación entre NSE y LLA', subtitle='Por provincia')+
theme_minimal()
Aplicamos una regresión lineal simple para ver cómo se relacionan las variables. Ya vimos que la relación varía mucho por región, así que vamos a incorporar esa variable también. Vemos que el R cuadrado es de 0.15 y el estimador de la variable NSE es -0.0029. Si aplico las variables transformadas, el estimador de NSE reduce su valor (a -0.0014) pero aumenta su significancia estadística. También es interesante ver el estimador por región: mucho más alto en Cuyo y Patagonia que en el resto de las regiones.
df_lm <- df %>%
select(ID, nse, lla_2023p_per,nse_tr, lla_2023p_per_tr, region, Provincia..filtro.) %>%
mutate(region = as.factor(region)) %>%
drop_na() %>%
st_make_valid()
# modelo simple
mod_form1 <- as.formula("lla_2023p_per ~ nse + region")
mod1 <- lm(mod_form1, data = st_drop_geometry(df_lm) )
summary(mod1)
Call:
lm(formula = mod_form1, data = st_drop_geometry(df_lm))
Residuals:
Min 1Q Median 3Q Max
-0.36017 -0.07342 0.00366 0.06692 0.74769
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.271437 0.006288 43.167 <2e-16 ***
nse -0.002981 0.001292 -2.307 0.0211 *
regionCentro 0.069693 0.004559 15.285 <2e-16 ***
regionCuyo 0.164620 0.006033 27.286 <2e-16 ***
regionNEA 0.001677 0.006344 0.264 0.7915
regionNOA 0.051188 0.005281 9.693 <2e-16 ***
regionPatagonia 0.110384 0.006280 17.576 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.1133 on 5542 degrees of freedom
Multiple R-squared: 0.1577, Adjusted R-squared: 0.1568
F-statistic: 172.9 on 6 and 5542 DF, p-value: < 2.2e-16# modelo con variables transformadas
mod_form1 <- as.formula("lla_2023p_per_tr ~ nse_tr + region")
mod1 <- lm(mod_form1, data = st_drop_geometry(df_lm) )
summary(mod1)
Call:
lm(formula = mod_form1, data = st_drop_geometry(df_lm))
Residuals:
Min 1Q Median 3Q Max
-0.38211 -0.07264 0.00733 0.07142 0.67428
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.3671300 0.0043887 83.654 < 2e-16 ***
nse_tr -0.0014250 0.0001904 -7.484 8.37e-14 ***
regionCentro 0.0769742 0.0046461 16.568 < 2e-16 ***
regionCuyo 0.1696199 0.0061623 27.525 < 2e-16 ***
regionNEA 0.0104427 0.0065195 1.602 0.109
regionNOA 0.0615960 0.0054640 11.273 < 2e-16 ***
regionPatagonia 0.1152627 0.0064011 18.007 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.1157 on 5542 degrees of freedom
Multiple R-squared: 0.1626, Adjusted R-squared: 0.1617
F-statistic: 179.3 on 6 and 5542 DF, p-value: < 2.2e-16Se chequean los supuestos, sin encontrar nada que se desplace mucho de lo esperado. Parece que los residuos se concentran espacialmente.
par(mfrow = c(2,2))
plot(mod1)
mod1_resid <- residuals(mod1)
summary(mod1_resid) Min. 1st Qu. Median Mean 3rd Qu. Max.
-0.382112 -0.072636 0.007326 0.000000 0.071422 0.674277 mod1_resid %>% hist()
df_lm %>%
drop_na(lla_2023p_per) %>%
mutate(resLM = mod1_resid) %>%
f_map(titulo="Distribución espacial de residuos", leyenda="Residuos", variable="resLM", paleta='divergente')
Calculamos autocorrelación espacial de los residuos: efectivamente hay autocorrelación (el valor-p nos confirma la significancia estadística).
class(df_lm)[1] "sf" "data.frame"gnb = poly2nb(df_lm, queen = F)
glw = nb2listw(gnb, zero.policy = T)
gnb <- poly2nb(df_lm, queen = F)
glw <- nb2listw(gnb, zero.policy = TRUE)
moran_g <- lm.morantest(mod1, listw = glw)
moran_g
Global Moran I for regression residuals
data:
model: lm(formula = mod_form1, data = st_drop_geometry(df_lm))
weights: glw
Moran I statistic standard deviate = 61.338, p-value < 2.2e-16
alternative hypothesis: greater
sample estimates:
Observed Moran I Expectation Variance
5.632346e-01 -1.190838e-03 8.467595e-05 Para aplicar una regresión geográficamente ponderada debemos definir un ancho de banda. En este caso se define un ancho de banda adaptativo con el método bisquare. Transformamos nuestros polígonos a centroides para poder realizar el cálculo. Quitamos la variable de región de la fórmula.
set.seed(42)
sf_use_s2(FALSE)
df_lm_filtrado <- df_lm %>%
st_centroid() %>%
st_make_valid() %>%
drop_na() %>%
distinct(geometry, .keep_all=T) %>%
na.omit()
gwr_form <- as.formula("lla_2023p_per_tr ~ nse_tr")
bwG <- gwr.sel(gwr_form,
data = st_drop_geometry(df_lm_filtrado),
coords = st_coordinates(df_lm_filtrado),
adapt = T,
gweight = gwr.bisquare,
verbose = F,
show.error.messages = F)
bwG[1] 0.008130619Aplicamos GWR con el ancho de banda que definimos.
mod_gwr <- gwr(gwr_form,
data = st_drop_geometry(df_lm_filtrado),
coords = st_coordinates(df_lm_filtrado),
adapt = bwG,
gweight = gwr.bisquare)
summary(mod_gwr) Length Class Mode
SDF 5050 SpatialPointsDataFrame S4
lhat 1 -none- logical
lm 11 -none- list
results 0 -none- NULL
bandwidth 5050 -none- numeric
adapt 1 -none- numeric
hatmatrix 1 -none- logical
gweight 1 -none- character
gTSS 1 -none- numeric
this.call 6 -none- call
fp.given 1 -none- logical
timings 8 -none- numeric Comparamos coeficientes de ambos modelos.
mod_gwr_coef <- mod_gwr[["lm"]] %>%
coefficients() %>%
as_tibble(rownames = "variable") %>%
rename(gwr = value)
data.frame(lm_orig = mod1 %>% coefficients()) %>%
as_tibble(rownames = "variable") %>%
left_join(mod_gwr_coef, by = "variable") %>%
mutate(across(where(is.numeric),
~round(.x, 4)))# A tibble: 7 × 3
variable lm_orig gwr
<chr> <dbl> <dbl>
1 (Intercept) 0.367 0.398
2 nse_tr -0.0014 -0.0004
3 regionCentro 0.077 NA
4 regionCuyo 0.170 NA
5 regionNEA 0.0104 NA
6 regionNOA 0.0616 NA
7 regionPatagonia 0.115 NA Analizamos resultados locales. Limpio la salida del modelo GWR; le sumo la variable “Provincia” que me quedó en el dataset anterior.
class(mod_gwr$SDF)[1] "SpatialPointsDataFrame"
attr(,"package")
[1] "sp"GWR_datos <- mod_gwr$SDF %>%
st_as_sf(sp) %>%
st_set_crs(st_crs(df_lm_filtrado)) %>%
st_join(select(df_lm_filtrado, Provincia..filtro.,ID))
GWR_datosSimple feature collection with 5050 features and 8 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: -72.38997 ymin: -54.42456 xmax: -53.89734 ymax: -21.8684
Geodetic CRS: WGS 84
First 10 features:
sum.w (Intercept) nse_tr gwr.e pred localR2
1 16.06692 0.2697071 0.001834747 -0.034271844 0.2766909 0.3600922
2 16.34200 0.2631696 0.002496022 -0.008930156 0.2729336 0.4528112
3 12.23066 0.2535704 0.002599820 -0.034478087 0.2865171 0.5693372
4 14.63063 0.2454652 0.003965229 -0.031167911 0.2562539 0.7090397
5 14.28309 0.2218686 0.006502930 -0.004962545 0.4247521 0.8555652
6 15.52366 0.2218704 0.006749308 -0.037753205 0.2352635 0.8426465
7 16.93539 0.2270152 0.006830607 -0.019498518 0.2470655 0.8154265
8 16.58562 0.2295895 0.006406119 0.001421351 0.2460493 0.8248548
9 16.49977 0.2380611 0.005834395 0.038508449 0.2614054 0.7693887
10 16.93628 0.2308356 0.007526231 -0.005994345 0.2603880 0.7650592
Provincia..filtro. ID geometry
1 CABA 1 POINT (-58.37133 -34.62387)
2 CABA 2 POINT (-58.37183 -34.61834)
3 CABA 3 POINT (-58.35417 -34.60971)
4 CABA 4 POINT (-58.36404 -34.60545)
5 CABA 5 POINT (-58.37397 -34.586)
6 CABA 6 POINT (-58.38263 -34.59179)
7 CABA 7 POINT (-58.38422 -34.59678)
8 CABA 8 POINT (-58.37676 -34.59619)
9 CABA 9 POINT (-58.37474 -34.60331)
10 CABA 10 POINT (-58.38688 -34.60167)Comparamos el R cuadrado de ambos modelos.
cat("R cuadrado del modelo lineal (global):", summary(mod1)$r.squared, "\n\n")R cuadrado del modelo lineal (global): 0.1625915 cat("Resumen de R cuadrado local:\n")Resumen de R cuadrado local:summary(GWR_datos$localR2) Min. 1st Qu. Median Mean 3rd Qu. Max.
-0.2232 0.2135 0.3419 0.3751 0.5206 0.9424 Comparamos el estimador en las distintas provincias. Vemos que en CABA y Tierra del Fuego tienen la mediana más alta (implica que son provincias donde mayor pobreza correlaciona con mayor voto a LLA) y en Formosa y Santiago del Estero la mediana es más baja (implica que son provincias donde menor pobreza correlaciona con mayor voto a LLA).
GWR_datos %>%
as.data.frame() %>%
group_by(Provincia..filtro.) %>%
summarise(nse_median = median(nse_tr)) %>%
arrange(nse_median) %>%
ggplot()+
geom_col(aes(x=reorder(Provincia..filtro., nse_median),
y=nse_median,
fill=nse_median))+
scale_fill_gradient2(low='blue',mid='lightgray',high='red',midpoint=0)+
theme_minimal()+
labs(title="Mediana del estimador NSE por provincia",
y="", x="")+
coord_flip()
Vemos el mapa del valor del R2 y el estimador a nivel local.
df_plot <- GWR_datos %>%
rename(lla_2023p__nse = nse_tr,
lla_2023p__localR2 = localR2) %>%
as.data.frame() %>%
select(ID, lla_2023p__nse,lla_2023p__localR2) %>%
right_join(df_lm, by='ID') %>%
st_as_sf() %>%
drop_na()
f_map(df_plot, titulo="Ajuste local del modelo", leyenda="R cuadrado", paleta='viridis', variable="lla_2023p__localR2")
f_map(df_plot, titulo="Estimador local: LLA ~ NSE", leyenda="NSE", paleta='divergente', variable="lla_2023p__nse")
A nivel de funcionamiento del modelo, vemos que el R2 es mayor en el AMBA, la región de Cuyo y la intersección entre las provincias de Tucumán, Salta y Santiago del Estero. Si prestamos atención al estimador, vemos que es mayor en la zona del AMBA y en la provincia de Buenos Aires en general y alcanza sus valores más bajos en las provincias del norte, el sur de Mendoza, Neuquén, Río Negro y el oeste de Chubut.
Es un comportamiento interesante si pensamos lo siguiente: gran parte de los votos de La Libertad Avanza se explican por el alto porcentaje que obtuvo en el mal llamado “interior” (lejos del AMBA). En esos lugares, el voto a LLA se asentó sobre la base sociodemográfica típica de Juntos por el Cambio (circuitos con mayor NSE), lo que permite entender el mal resultado de JxC a nivel nacional en comparación con las elecciones anteriores.
Ahora bien, la situación de la Provincia de Buenos Aires presenta una particularidad: primero, es hoy el bastión de la representación electoral del peronismo (no incluyo aquí a los peronismos provinciales como el cordobés, que tienen juego propio). Si el voto a LLA se asienta sobre la base sociodemográfica típica del peronismo (circuitos con menor NSE), implica que funciona de manera complementaria con JxC. Esto puede tener dos implicancias: primero, es un incentivo a una lista única entre LLA-PRO para las próximas elecciones, ya que no compiten por el mismo electorado; por otro, incluso sin lista única, cualquier crecimiento de LLA podemos suponer que se hará sobre la base típica del peronismo.
La forma de visualizar la información geográfica que se eligió esconde algo que hay que tener en cuenta al momento de analizar los resultados. El tamaño de los circuitos electorales está íntimamente relacionado con la densidad poblacional, por lo tanto, en regiones menos densas (como la Patagonia) los centroides (forma geográfica en la que trabajamos la GWR) están más separados entre sí.
ggplot()+
geom_sf(data=GWR_datos, size=1, alpha=.2, color='blue')+
geom_sf(data=df_prov, fill=NA)+
labs(title="Centroides", subtitle='Argentina - circuitos electorales')+
theme_void()
A modo de extra, veamos cómo quedan los mapas para otros partidos. Para esto, se creó una función que contiene todo el proceso de aplicación de la GWR.
f_gwr <- function(db, vari){
condition <- paste0(vari, " > 0")
boxcox_trans <- db %>%
as.data.frame() %>%
select(matches(vari)) %>%
filter(!!rlang::parse_expr(condition)) %>%
select(where(is.numeric)) %>%
car::powerTransform()
tr <- summary(boxcox_trans)[["result"]][ , "Rounded Pwr"]
vari_tr <- paste0(vari, "_tr")
db <- db %>%
mutate(
!!vari_tr := (!!sym(vari))^tr
)
sf_use_s2(FALSE)
condition <- paste0(vari_tr, " > 0")
db_filtrado <- db %>%
select(ID, nse_tr, matches(!!vari_tr)) %>%
filter(!!rlang::parse_expr(condition)) %>%
st_centroid() %>%
st_make_valid() %>%
drop_na() %>%
distinct(geometry, .keep_all=T) %>%
na.omit() %>%
filter(!st_is_empty(geometry))
formu <- as.formula(paste0(vari_tr," ~ nse_tr"))
bwG <- gwr.sel(formu,
data = st_drop_geometry(db_filtrado),
coords = st_coordinates(db_filtrado),
adapt = T,
gweight = gwr.bisquare,
verbose = F, show.error.messages = F)
mod_gwr <- gwr(formu,
data = st_drop_geometry(db_filtrado),
coords = st_coordinates(db_filtrado),
adapt = bwG,
gweight = gwr.bisquare)
vari_tr__nse <- paste0(vari_tr, "__nse")
vari_tr__r2 <- paste0(vari_tr, "__r2")
mod_gwr_datos <- mod_gwr$SDF %>%
st_as_sf(sp) %>%
st_set_crs(st_crs(db_filtrado)) %>%
rename(!!vari_tr__nse := nse_tr,
!!vari_tr__r2 := localR2) %>%
st_join(select(db_filtrado,ID)) %>%
select(ID, !!vari_tr__nse, !!vari_tr__r2)
return(mod_gwr_datos)
}
# chequeamos que la función devuelva sólo las columnas que nos interesa
df_test <- filter(df, Provincia..filtro.=="Córdoba")
temp <- f_gwr(db=df_test, vari="lla_2023p_per_tr")
temp %>% head(3)Simple feature collection with 3 features and 3 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: -64.18262 ymin: -31.41708 xmax: -64.10847 ymax: -31.37131
Geodetic CRS: WGS 84
ID lla_2023p_per_tr_tr__nse lla_2023p_per_tr_tr__r2
1 599 -0.0003840059 0.1409953
2 600 0.0029798494 0.3619044
3 601 0.0029748690 0.3751451
geometry
1 POINT (-64.10847 -31.37131)
2 POINT (-64.18262 -31.41708)
3 POINT (-64.18189 -31.4088)Vamos a comparar el resultado para las internas en las paso 2023 y los partidos para las generales 2023.
df <- df %>%
mutate(uxp_grabois_2023p_per = uxp_grabois_2023p / afirmativos_2023p,
uxp_massa_2023p_per = uxp_massa_2023p / afirmativos_2023p,
uxp_2023g_per = uxp_2023g / afirmativos_2023g,
uxp_2023b_per = uxp_2023b / afirmativos_2023b,
hxp_2023g_per = hxp_2023g / afirmativos_2023g,
lla_2023g_per = lla_2023g / afirmativos_2023g,
fit_2023g_per = fit_2023g / afirmativos_2023g,
jxc_larreta_2023p_per = jxc_larreta_2023p / afirmativos_2023p,
jxc_bullrich_2023p_per = jxc_bullrich_2023p / afirmativos_2023p,
jxc_2023g_per = jxc_2023g / afirmativos_2023p,
fdt_2021g_per = fdt_2021g / afirmativos_2021g,
fdt_2019g_per = fdt_2019g / afirmativos_2019g) %>%
mutate(jxc_2023g_per = case_when(jxc_2023g_per > 1 ~ NA,
TRUE ~ as.numeric(jxc_2023g_per)))
partidos_2023 <- c( "uxp_grabois_2023p_per", "uxp_massa_2023p_per", "jxc_larreta_2023p_per", "jxc_bullrich_2023p_per","jxc_2023g_per", "uxp_2023g_per", "lla_2023g_per", "hxp_2023g_per", "fit_2023g_per")
names(df_plot) [1] "ID" "lla_2023p__nse" "lla_2023p__localR2"
[4] "nse" "lla_2023p_per" "nse_tr"
[7] "lla_2023p_per_tr" "region" "Provincia..filtro."
[10] "geometry" for (partido in partidos_2023){
print(partido)
resultado <- NA
resultado <- tryCatch(
{
f_gwr(db = df, vari = partido)
},
error = function(e) {
message(paste("Error con partido:", partido, "-", e$message))
NULL # Retorna NULL si hay error
}
)
if (!is.null(resultado)){
df_plot <- resultado %>%
as.data.frame() %>%
select(-geometry) %>%
right_join(df_plot, by='ID') %>%
st_as_sf()
}
print("terminado")
}[1] "uxp_grabois_2023p_per"
[1] "terminado"
[1] "uxp_massa_2023p_per"
[1] "terminado"
[1] "jxc_larreta_2023p_per"
[1] "terminado"
[1] "jxc_bullrich_2023p_per"
[1] "terminado"
[1] "jxc_2023g_per"
[1] "terminado"
[1] "uxp_2023g_per"
[1] "terminado"
[1] "lla_2023g_per"
[1] "terminado"
[1] "hxp_2023g_per"
[1] "terminado"
[1] "fit_2023g_per"
[1] "terminado"Veamos el resultado de UxP y JxC.
f_map(df_plot, titulo="Estimador local: UxP ~ NSE", leyenda="NSE", paleta='divergente', variable="uxp_2023g_per_tr__nse")
f_map(df_plot, titulo="Estimador local: JxC ~ NSE", leyenda="NSE", paleta='divergente', variable="jxc_2023g_per_tr__nse")
Probamos con el peronismo histórico.
partidos_pj <- c("fdt_2019g_per","fdt_2021g_per",'uxp_2023b_per')
for (partido in partidos_pj){
print(partido)
resultado <- NA
resultado <- tryCatch(
{
f_gwr(db = df, vari = partido)
},
error = function(e) {
message(paste("Error con partido:", partido, "-", e$message))
NULL # Retorna NULL si hay error
}
)
if (!is.null(resultado)){
df_plot <- resultado %>%
as.data.frame() %>%
select(-geometry) %>%
right_join(df_plot, by='ID') %>%
st_as_sf()
}
print("terminado")
}[1] "fdt_2019g_per"
[1] "terminado"
[1] "fdt_2021g_per"
[1] "terminado"
[1] "uxp_2023b_per"
[1] "terminado"Veamos el resultado para el peronismo histórico.
f_map(df_plot, titulo="Estimador local: FDT 2019 ~ NSE", leyenda="NSE", paleta='divergente', variable="fdt_2019g_per_tr__nse")
f_map(df_plot, titulo="Estimador local: FDT 2021 ~ NSE", leyenda="NSE", paleta='divergente', variable="fdt_2021g_per_tr__nse")
f_map(df_plot, titulo="Estimador local: UXP 2023G ~ NSE", leyenda="NSE", paleta='divergente', variable="uxp_2023g_per_tr__nse")
f_map(df_plot, titulo="Estimador local: UXP 2023B ~ NSE", leyenda="NSE", paleta='divergente', variable="uxp_2023b_per_tr__nse")
De Grande, Pablo y Salvia, Agustín (2021). Estratificación y desigualdad social (total país), 2010. Recuperado el 13 de octubre, 2024, de https://mapa.poblaciones.org/map/97801↩︎