Participación femenina en las elecciones de EE.UU.
Script
Código
# paquetes ----------------------------------------------------------------library(tidyverse)library(fontawesome)library(gender)library(showtext)library(glue)library(ggtext)# fuente ------------------------------------------------------------------# coloresc1 <-"#88C0D0"c2 <-"#81A1C1"c3 <-"#5E81AC"c4 <-"grey90"c5 <-"#306489"c6 <-"#222B4C"# texto gralfont_add_google(name ="Ubuntu", family ="ubuntu")# algoritmos, eje verticalfont_add_google(name ="Victor Mono", family ="victor", db_cache =FALSE)# eje horizontal, añosfont_add_google(name ="Bebas Neue", family ="bebas", db_cache =FALSE)# títulofont_add_google(name ="Vast Shadow", family ="vast")# íconosfont_add("fa-brands", "icon/Font Awesome 6 Brands-Regular-400.otf")font_add("fa-solids", "icon/Font Awesome 6 Free-Solid-900.otf")font_add("fa-regular", "icon/Font Awesome 6 Free-Regular-400.otf")showtext_auto()showtext_opts(dpi =300)# captionfuente <-glue("Datos: <span style='color:{c3};'><span style='font-family:mono;'>","{{<b>tidytuesdayR</b>}}</span> semana 45. ","MIT Election Data and Science Lab, ","**Harvard Dataverse**</span>")autor <-glue("Autor: <span style='color:{c3};'>**Víctor Gauto**</span>")icon_twitter <-glue("<span style='font-family:fa-brands;'></span>")icon_github <-glue("<span style='font-family:fa-brands;'></span>")usuario <-glue("<span style='color:{c3};'>**vhgauto**</span>")sep <-glue("**|**")mi_caption <-glue("{fuente}<br>{autor} {sep} {icon_github} {icon_twitter} {usuario}")# datos -------------------------------------------------------------------browseURL("https://github.com/rfordatascience/tidytuesday/blob/master/data/2023/2023-11-07/readme.md")house <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-11-07/house.csv')# me interesa el género de los candidatos y la proporción en el tiempo# función para obtener el 1er nombre, y si es una sola letra, el segundoget_first_name <-function(name) { name_parts <-str_split(name, " ")[[1]]if (nchar(name_parts[1]) ==1) {return(name_parts[2]) } else {return(name_parts[1]) }}# primer nombre de cada candidato, agrupado por año# se agrupan, por año, los mismos nombresd <- house |>filter(!writein) |>select(year, candidate) |>mutate(primer =map(.x = candidate, ~get_first_name(name = .x))) |>unnest(primer) |>count(primer, .by = year) |>arrange(.by) |>rename(year = .by)# por cada algoritmo, obtengo el género del candidatod_ipums <- d |>mutate(genero =map(.x = primer, (x) gender(x, countries ="United States", method ="ipums")$gender))d_ssa <- d |>mutate(genero =map(.x = primer, (x) gender(x, countries ="United States", method ="ssa")$gender))d_napp <- d |>mutate(genero =map(.x = primer, (x) gender(x, method ="napp")$gender))# unifico los resultados de todos los algoritmose <-bind_rows( d_ipums |>mutate(tipo ="ipums"), d_napp |>mutate(tipo ="napp"), d_ssa |>mutate(tipo ="ssa")) |>mutate(genero =as.character(genero)) |>filter(genero !="logical(0)") |>mutate(g = genero =="male") |>reframe(p =sum(g*n)/sum(n), .by =c(year, tipo)) |>mutate(p =1- p)# la asignación del género a partir del nombre, por cada algoritmo, lleva mucho# tiempo. Entonces, guardo los resultados y leo desde el archivo .tsve |>write_tsv("2023/semana_45/datos.tsv")e <-read_tsv("2023/semana_45/datos.tsv")# figura ------------------------------------------------------------------# etiquetas de los algoritmos, para agregar en el borde derechoalgoritmo_label <- e |>filter(year ==max(e$year))# función para aplicar fuente mono (victor) a los nombres de los algortimosf_mono_it <- (x) glue("<span style='font-family:victor'>{x}</span>")# puntos de la grilla, de fondo de la figurap <-expand.grid(x =seq(1980, 2020, 10),y =seq(.1, .3, .05)) |>as_tibble()# título, subtítulo y aclaración del la asignación del género a partir de# los algoritmosmi_tit <-glue("Año a año, hay másnmujeres candidatasnal Congreso de EE.UU.") |>str_to_upper()mi_sub <-glue("Hace 40 años, hubo **10%** de candidatas mujeres a la Cámara<br>","de Representantes de **EE.UU.** Actualmente ronda el **30%**,<br>","todavía lejos de una total paridad.<br>")mi_texto <-glue("El porcentaje se calculó a partir del nombre del candidato<br>","utilizando tres algoritmos diferentes ({f_mono_it('IPUMS')},","{f_mono_it('NAPP')} y {f_mono_it('SSA')}).")# figurag <-ggplot(e, aes(year, p, color = tipo)) +# puntos de la grillaannotate(geom ="point", x = p$x, y = p$y, color = c5, shape =18) +# líneas de los algoritmos de génerogeom_line(alpha = .4, linewidth =1.5, show.legend =FALSE) +# puntosgeom_point(shape =15, size =4) +geom_point(shape =18, size =6) +geom_point(size =1, color ="white", shape =20) +# etiquetas de los algoritmosgeom_text(data = algoritmo_label, aes(year, p, label =str_to_upper(tipo)), size =6,hjust =0, vjust =1, nudge_x = .3, nudge_y =-.005, family ="victor")+# títuloannotate(geom ="text", x =1976, y = .3, hjust =0, vjust =0, label = mi_tit, family ="vast", size =12, color = c4) +# subtítuloannotate(geom ="richtext", x =1976, y = .295, hjust =0, vjust =1, label = mi_sub, family ="ubuntu", size =7, color = c1, fill =NA, label.color =NA) +# aclaración algoritmosannotate(geom ="richtext", x =2022, y = .05, hjust =1, vjust =0, label = mi_texto, family ="ubuntu", size =5, color = c1, fill =NA, label.color =NA) +scale_y_continuous(breaks =seq(.05, .35, .05), limits =c(.05, .35), expand =c(0, .01),labels = scales::label_percent(decimal.mark =",", big.mark =".")) +scale_color_manual(values =c(c1, c2, c3)) +coord_cartesian(clip ="off") +labs(caption = mi_caption) +theme_void() +theme(plot.margin =margin(10, 20, 10, 10),plot.background =element_rect(fill = c6, color = c5,linewidth =3),plot.caption =element_markdown(color = c4, size =12, family ="ubuntu", margin =margin(15, 0, 10, 0)),plot.caption.position ="plot",panel.grid.major =element_line(color ="#306489", linetype ="8f", linewidth = .2),axis.text =element_text(color = c4),axis.text.x =element_text(family ="bebas", size =35),axis.text.y =element_text(family ="victor", size =15, vjust =0),legend.position ="none" )# guardoggsave(plot = g,filename ="2023/semana_45/viz.png",width =30,height =30,units ="cm")# abrobrowseURL("2023/semana_45/viz.png")
