Galería de gráficos del PEN con ggplot2
Realizado por: Steffan Gómez Campos
Email: sgomez@estadonacion.or.cr
Programa Estado de la Nación (PEN), Costa Rica
www.estadonacion.or.cr
Mayo de 2018
Introducción
Este documento se basa en los principios de Open Source y de Open Data. De Open Source porque todos los procesamientos se realizan con software libre (R y sus paquetes), y de Open Data porque es de código abierto, es decir, se puede replicar cada uno de los gráficos dado que incluyen su respectivo código (seleccionar botón Code a la par de cada visualización).
Acá se incluyen las principales visualizaciones realizadas para el PEN durante el 2016 y 2017, con insumos de diferentes colegas del equipo. Fue producido en sistema Mac OS. Se estructura en dos partes:
- Breve introducción sobre la gramática de gráficos
- Galería de gráficos del PEN según características
La mayoría de las visualizaciones que se muestran acá se encuentran publicadas en los diferentes informes del Programa Estado de la Nación, en la página web del PEN en http://www.estadonacion.or.cr o en la Plataforma Electoral 2018 en http://www.VotemosCR.com
1) Gramática de gráficos y ggplot
La gramática de gráficos es una herramienta que permite describir, de manera concisa, los componentes de un gráfico. Se trata de una serie de reglas y principios que facilitan la construcción de distintas visualizaciones. Como en el lenguaje, la buena gramática es el primer paso para construir una buena oración (Wickham, 2010).
Se basa en el trabajo de Leland Wilkinson (2005), implementado por Hadley Wickham para ggplot en R. Se puede ver el CheatSheet de ggplot2 en el siguiente link: https://goo.gl/LvJCc5.
Los componentes de la gramática de gráficos son:
Los datos (en formato tidy): esto puede tomar hasta el 80% del trabajo, y es central para el análisis y replicar posteriormente las visualizaciones. R tiene múltiples paquetes que facilitan significativamente este proceso. Por ejemplo tidyr y dplyr (para data wrangling) y lubridate (para fechas) entre otros. Para más detalle ver: http://vita.had.co.nz/papers/tidy-data.pdf
Aesthetics: refiere a las características de formato del gráfico y se incluyen en el código dentro del parámetro
aes().Posición de las variables: tiene efectos directos sobre la claridad del gráfico. Los datos deben posicionarse adecuadamente sobre el eje X (generalmente la variable independiente), o el eje Y (variable dependiente) de acuerdo con el análisis realizado. Dentro del gráfico los geométricos pueden ser ubicados según el interés: uno a la par del otro (
position = "dodge"), apilados (position = "fill"oposition = "stack"según se quiera), o incluso separados en caso de superposición de datos (position = "jitter").Atributos: incluye el tamaño de los elementos dentro del gráfico, las etiquetas y el color, entre otros aspectos. En este enlace se puede ver la paleta de color compatible con ggplot2: https://goo.gl/vTd1Ps. Es importante considerar que los gráficos deben incluir una paleta de tonos apta para personas daltónicas (colorblind). Por ejemplo, evitar la combinación del rojo y el verde.
Transformación de variables: que pueden realizarse mediantes estadísticos en el mismo gráfico (stats). Por ejemplo, si la información son datos agrupados, la variable no requiere ninguna transformación y se debe plotear con la función
stat="identity". Pero si son datos sin agrupar, es posible contar todas las observaciones y graficar barras por categorías para lo cuál se requiere unstat="count". Otras transformaciones posibles son: smooth, quantile, density, boxplot, sumas, log, etc.Geométricos: ggplot utiliza una amplia gama de opciones geométricas para graficar y que se indican en el código con el parámetro
geom_por ejemplogeom_barogeom_tilepor nombrar dos. Incluye, líneas, puntos, barras, areas, path, polígonos (para mapas), entre otras. La decisión depende del tipo y la cantidad de variables. Más detalle sobre este aspecto se puede ver en el CheatSheet de ggplot indicado anteriormente.Escalas: La definición de las escalas también depende del tipo de datos. Pueden ser variables continuas o discretas. Sobre ambas es posible definir límites de los ejes (para hacer un zoom sobre la imagen) o bien utilizar breaks (para mostrar solo la información deseada). Ver en los códigos, más abajo, los parámetros referidos a
scale_x_discreteoscale_y_continuospara detalles de opciones.Coordenadas: refiere a la proyección de los datos sobre coordenadas de tipo cartesiana, polar (circular), o en latitud y longitud (mapas), entre otros aspectos. También es posible rotar las coordenadas con el parámetro
flip()o realizar transformaciones, por ejemplocoord_trans(ytrans = "sqrt").Facetas y agrupación: permite realizar gráficos más complejos con mucha información que de otra forma sería muy dificil de observar en un gráfico sencillo. Incluye la posibilidad de hacer subplots, o los conocidos small multiples, que en su mayoría utilizan variables discretas como forma de agrupación. Por ejemplo: sexo, mes (fechas), u otra categoría realizada en el análisis. En el código se pueden identificar con el parámetro
facet_wrap()yfacet_grid().Temas y formato: este es un aspecto central en el trabajo del PEN dado que, en pocas líneas, se puede replicar el formato exacto para todos los gráficos que se realicen. El tema permite estandarizar el formato (color, tamaño, ubicación) de los título de ejes, fondo del gráfico, las leyendas, el grid (interlineado en el fondo), los ticks de los ejes, entre otros. En los códigos de abajo se pueden ver las opciones bajo el parámetro
theme(). Algunos temas han sido inspirados en los formatos utilizados por The Economist, el Wall Street Journal, o el sitio Fivethirtyeight.com entre otros. También se pueden replicar gráficos desde R en formato de Stata, SPSS, o Excel. Esas plantillas pueden ser accedidas en el paqueteggthemes.
2) Galería de gráficos PEN
¿Cómo hacer un gráfico similar al de Minard con datos del PEN?
Para el Informe 23 del Estado de la Nación, el Capítulo de Equidad e Integración Social requería graficar un mapa de ruta de buses. Se siguieron los pasos anteriores para obtener este gráfico:
- Las líneas son cada ruta, distinguidas por el color (paleta de color para daltónicos “colorblind”).
- Cada punto es una parada de bus con su etiqueta respectiva.
- Las líneas punteadas marcan paradas donde es posible hacer cambio de ruta.
- El valor del subsidio (en la tarifa) está en el rectángulo afuera del gráfico.
- Para dar efecto de mapa, se define el tema del gráfico en blanco:
theme_minimal()ytheme(panel.grid = element_blank()).
El código permite ver la implementación de estos elementos en capas con ggplot.
library(ggplot2)
# Se hacen los datos
datos <- data.frame(origen=c(rep("Ruta 126", 7), rep("Ruta 131", 6), rep("Ruta 132", 6)),
destino=c("San José", "Jericó", "Guadarrama", "San Juan Norte", "San Juan Sur", "Río Conejo", "Loma Larga",
"Cartago", "Copalchí", "El Alumbre", "San Juan Norte", "San Juan Sur", "Loma Larga",
"San Juan Norte", "Calle Valverde", "Calle Abarca", "San Juan Sur", "Río Conejo", "Loma Larga"),
subsidio=c("","-345","-135","-400","-325","-155","400", "", "230", "255", "515", "530", "2150", rep("",6)))
# Formato a factores
datos$destino <- factor(datos$destino, levels = c("San José", "Cartago","Jericó", "Copalchí", "Guadarrama", "El Alumbre", "San Juan Norte", "Calle Valverde", "Calle Abarca", "San Juan Sur", "Río Conejo", "Loma Larga"))
datos$origen <- factor(datos$origen, levels = c("Ruta 126", "Ruta 132", "Ruta 131"))
# Se definen dos grupos de puntos para etiquetas
etiqueta1 <- c("San José", "Cartago","Jericó", "Copalchí", "Guadarrama", "El Alumbre", "Calle Valverde", "Calle Abarca", "Río Conejo")
etiqueta2 <- c("San Juan Norte", "San Juan Sur", "Loma Larga")
# etiquetas para subsidio
text1 <- c("-345","-135","-400","-325","-155","400")
text2 <- c("230", "255", "515", "530", "2150")
head(datos)## origen destino subsidio
## 1 Ruta 126 San José
## 2 Ruta 126 Jericó -345
## 3 Ruta 126 Guadarrama -135
## 4 Ruta 126 San Juan Norte -400
## 5 Ruta 126 San Juan Sur -325
## 6 Ruta 126 Río Conejo -155# Grafico
ggplot(datos, aes(destino, origen, group=origen)) +
geom_path(size=10, aes(color=origen), lineend = "round") +
geom_segment(aes(x=7, xend=7, y= 1, yend=3), size=1, color="grey20", linetype=3) +
geom_segment(aes(x=10, xend=10, y= 1, yend=3), size=1, color="grey20", linetype=3) +
geom_segment(aes(x=12, xend=12, y= 1, yend=3), size=1, color="grey20", linetype=3) +
geom_segment(aes(x=11, xend=11, y= 1, yend=2), size=1, color="grey20", linetype=3) +
geom_point(size=6) +
scale_color_manual("", values = c("steelblue3", "firebrick2", "goldenrod")) +
geom_text(data= subset(datos, destino %in% etiqueta1), aes(label=destino), nudge_y = .25, size=3, angle=45, fontface="bold") +
geom_text(data= subset(datos, destino %in% etiqueta2 & origen== "Ruta 126"), aes(label=destino), nudge_y = -.2, size=3, fontface="bold") +
geom_label(data= subset(datos, subsidio %in% text1 & origen== "Ruta 126"), aes(label=subsidio), nudge_y = -.5, size=3, fontface="bold") +
geom_label(data= subset(datos, subsidio %in% text2 & origen== "Ruta 131"), aes(label=subsidio), nudge_y = .52, size=3, fontface="bold") +
labs(x="", y="",
title="Recorrido de las rutas de buses 126, 131 y 132 y estimación de los subsidios en las tarifas") +
theme_minimal() +
theme(panel.grid = element_blank()) +
theme(axis.text = element_blank()) +
theme(legend.text = element_text(size = 14)) +
theme(legend.position = "bottom") +
guides(color = guide_legend(nrow=3, reverse = T))
A continuación más ejemplos ordenados según el tipo. En todos los casos es posible ver el detalle del código al desplegar el botón al lado del gráfico. En ocasiones aparece un head() de los datos para mostrar la estructura de la información que alimenta cada visualización.
Barras geom_bar()
Los gráficos de barras pueden ser sobre datos agrupados o datos sin agrupar. El código cambia según cada caso. Veámos algunos ejemplos.
Barras una a la par de la otra (dodge) con datos agrupados:
El Índice de estabilidad democrática incluye una línea de promedio en el centro y dos etiquetas que marcan períodos distintos del sistema de partidos. Dado que son datos ya agrupados, el código define el geométrico y el tipo de lectura que se hace de los datos geom_bar(stat = "identity")
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
# se cargan los datos
datos <- read.csv("EstabilidadDemocratica.csv", sep = ";")
# Se sustituyen los NA por espacios en blanco
datos[8,1] <- ""
datos[10,1] <- " "
# Orden a factor
datos$Año <- factor(datos$Año, levels = c("1978", "1980", "1983", "1985", "1987", "1990", "1995", "", "1999", " ", "2004", "2006", "2008", "2010", "2012", "2014", "2015", "2016"))
# para ver la estructura de los datos
head(datos) ## Año Indice Promedio
## 1 1978 46 45
## 2 1980 66 45
## 3 1983 51 45
## 4 1985 54 45
## 5 1987 51 45
## 6 1990 46 45#Grafico
ggplot(datos, aes(x=Año, y=Indice)) +
geom_bar(stat = "identity", fill="steelblue") +
geom_text(aes(label=Indice), data = subset(datos, Indice>1), vjust=-.2, size=5, fontface="bold") +
geom_line(aes(y=Promedio, group=1, color="Promedio"), size=1, linetype=2) +
annotate("text", x = 4, y = 75, label = "Bipartidismo", size=5, fontface="bold") +
annotate("text", x = 14, y = 75, label = "Multipartidismo", size=5, fontface="bold") +
scale_color_manual("", values = c("black")) +
scale_y_continuous(breaks = seq(0,80,10), limits = c(0,80), expand = c(0,0)) +
ggtitle("Índice de estabilidad democrática en Costa Rica") +
theme_classic() +
theme(axis.title = element_text(size = 15), axis.text = element_text(size=14)) +
theme(legend.text = element_text(size = 14)) +
theme(axis.line.y = element_blank(), axis.text.y = element_blank(), axis.title.y = element_blank(), axis.ticks.y = element_blank()) +
theme(legend.position = "bottom")
Barras una a la par de la otra (dodge) con datos no agrupados:
El código cambia levemente cuando los datos no son agrupados, ya que se requiere indicar al geométrico el tipo de agrupación que debe hacer sobre la información. En este caso es un conteo de observaciones, el código lo denota en geom_bar(stat = "count", position = "dodge", color="white")
################################################
# Base con todos los comunicados
################################################
library(dplyr)
library(tidyr)
library(ggplot2)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("BBDDComunicados_v29-7-17.csv",sep = ";", stringsAsFactors = F)
# se da formato a fecha
datos$Fecha <- as.Date(datos$Fecha, format = "%m/%d/%Y")
# Se hacen tres subsets: Bilaterales, Multilaterales y Domestico
Multilateral <- datos %>% subset(Alcance == "Multilaterales")
Bilateral <- datos %>% subset(Alcance == "Bilaterales")
Domestica <- datos %>% subset(Alcance == "Politica domestica")
#Formato a levels
Bilateral$Región <- factor(Bilateral$Región, levels = c("Europa", "Asia", "Sudamerica", "Medio Oriente", "Centroamerica y Caribe", "Norteamerica", "Africa", "Oceania", "Varios"))
levels(Bilateral$Región) <- c("Europa", "Asia", "Sudamérica", "Medio\nOriente", "Centroamérica\ny Caribe", "Norteamérica", "África", "Oceanía", "Varios")
# para ver la estructura de los datos
head(Bilateral) ## ID Fecha Año Año_Gob
## 2 2 2014-05-05 2014 Primer año
## 6 6 2014-05-15 2014 Primer año
## 7 7 2014-05-15 2014 Primer año
## 9 9 2014-05-15 2014 Primer año
## 11 11 2014-05-21 2014 Primer año
## 13 13 2014-05-21 2014 Primer año
## Título
## 2 Costa Rica saluda al pueblo y Gobierno de República de Panamá por celebración de proceso electoral
## 6 Costa Rica expresa solidaridad con el pueblo y el Gobierno de Nigeria ante el secuestro de 200 estudiantes adolescentes
## 7 Costa Rica saluda al pueblo y al Gobierno de la República de Sudáfrica por celebración de proceso electoral
## 9 Costa Rica expresa solidaridad con el pueblo y el Gobierno de Turquía
## 11 Costa Rica saluda al pueblo y al Gobierno de la República de la India por la celebración de elecciones generales
## 13 Costa Rica expresa solidaridad con Bosnia y Herzegovina, Croacia y Serbia
## Alcance País Región Domestico Organismo
## 2 Bilaterales Panama Centroamérica\ny Caribe <NA> <NA>
## 6 Bilaterales Nigeria África <NA> <NA>
## 7 Bilaterales Sudafrica África <NA> <NA>
## 9 Bilaterales Turquia Medio\nOriente <NA> <NA>
## 11 Bilaterales India Asia <NA> <NA>
## 13 Bilaterales Varios Europa <NA> <NA>
## Organismo_RECOD
## 2 <NA>
## 6 <NA>
## 7 <NA>
## 9 <NA>
## 11 <NA>
## 13 <NA>
## Breve.descripción.o.asunto
## 2 Costa Rica saluda al Gobierno y Pueblo panameño por las pasadas elecciones presidenciales.
## 6 Costa Rica expresa su solidaridad con el pueblo y Gobierno nigeriano ante el secuestro de 200 estudiantes, remarcando el compromiso por la protección de los derechos del niño que ostenta Costa Rica.
## 7 Costa Rica saluda las elecciones llevadas a cabo el 07/05/2014 en Sudáfrica que han llevado a la elección del Congreso Nacional Africano.
## 9 Costa Rica expresa su solidaridad con el pueblo y Gobierno turco ante la explosión que ha causado la muerte de 245 fallecidos y cientos de atrapados.
## 11 Costa Rica saluda las elecciones generales llevadas a cabo en la India.
## 13 Costa Rica lamenta las inundaciones sucedidas en Bosnia y Herzegovina, Croacia y Serbia y lamenta las perdidas causadas.# GRAFICO (Otros colores para PPT)
ggplot(Bilateral, aes(Región, fill=Año_Gob)) +
geom_bar(stat = "count", position = "dodge", color="white") +
scale_fill_manual("Año de gobierno ", values = c("Primer año"="grey50", "Segundo año"="turquoise4", "Tercer año"="grey15"), label=c("Primero ", "Segundo ", "Tercero")) +
scale_y_continuous(expand = c(0,0)) +
theme_classic() +
labs(x="\nRegión",y="Cantidad de comunicados",
title="Cantidad de comunicados sobre relaciones bilaterales según región por año de gobierno",
subtitle= "(ordenados por cantidad emitida en el tercer año y zona específica)") +
theme(legend.position = "bottom") +
theme(axis.text = element_text(size = 15), axis.title = element_text(size = 16), legend.text = element_text(size = 16), legend.title = element_text(size = 16))
Barras apiladas (stack):
Este representa el porcentaje de mujeres en las cúpulas partidarias. Incluye el detalle por sexo (color), el porcentaje exacto (etiquetas) y el orden según participación femenina en cada partido (posición). Se define la leyenda abajo, y el tema es blanco. Nótese el position=stack en el código.
library(ggplot2)
library(dplyr)
library(tidyquant)
library(ggrepel) # editar etiquetas en gráfico
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("CupulasPartidarias_v19-07-17.csv", sep = ";", stringsAsFactors = F)
# Se limpia DF
datos <- datos %>% mutate(GradoPermanenciaFinal=replace(GradoPermanencia, GradoPermanencia == "#VALUE!", NA))
## Se limpia variable Dias Puesto
datos <- datos %>% mutate(DiasPuestoFinal=replace(DiasPuesto, DiasPuesto == "Cubierto", NA))
# Partidos a siglas
datos$PartidoPoliticoSigla <- ifelse(datos$PartidoPolitico == "Partido Liberacion Nacional", "PLN",
ifelse(datos$PartidoPolitico == "Partido Unidad Social Cristiana", "PUSC",
ifelse(datos$PartidoPolitico == "Partido Movimiento Libertario", "ML",
ifelse(datos$PartidoPolitico == "Partido Renovacion Costarricense", "RC",
ifelse(datos$PartidoPolitico == "Partido Accion Ciudadana", "PAC",
ifelse(datos$PartidoPolitico == "Partido Frente Amplio", "FA",
ifelse(datos$PartidoPolitico == "Partido Accesibilidad sin Exclusion", "PASE", "ERROR")))))))
# Se da formato numerico
datos$GradoPermanenciaFinal <- as.numeric(datos$GradoPermanenciaFinal)
datos$DiasPuestoFinal <- as.numeric(datos$DiasPuestoFinal)
# Se agrupan los datos por lider y partido (porcentaje del tiempo)
datosAgrupados <- subset(datos) %>% select(NombreLider, Sexo, GradoPermanenciaFinal, PartidoPoliticoSigla) %>%
group_by(NombreLider, Sexo, PartidoPoliticoSigla) %>% summarise(Total=(sum(GradoPermanenciaFinal, na.rm = TRUE)))
#se ordena el DF y se da orden a partidos
datosAgrupados <- arrange(datosAgrupados, desc(Total))
datosAgrupados$PartidoPoliticoSigla <- factor(datosAgrupados$PartidoPoliticoSigla, levels = c("PASE", "RC", "ML", "FA", "PAC", "PUSC", "PLN"))
# Se filtran los datos para sacar la proporcion por grupo
datosGenero <- datosAgrupados %>% group_by(PartidoPoliticoSigla, Sexo) %>% summarise (n = n()) %>%
mutate(porcentaje = n / sum(n))
datosGenero$PartidoPoliticoSigla <- factor(datosGenero$PartidoPoliticoSigla, levels = rev(c("PAC", "PASE", "PLN", "PUSC", "ML", "FA", "RC")))
datosGenero$Sexo <- factor(datosGenero$Sexo, levels = c("M", "F"))
# ver tabla
head(datos)## NombreLider PartidoPolitico Sexo
## 1 Luis Alberto Monge Alvarez Partido Liberacion Nacional M
## 2 Rafael Angel Calderon Fournier Partido Unidad Social Cristiana M
## 3 Oscar Arias Sanchez Partido Liberacion Nacional M
## 4 Rafael Angel Calderon Fournier Partido Unidad Social Cristiana M
## 5 Carlos Manuel Castillo Morales Partido Liberacion Nacional M
## 6 Jose Maria Figueres Olsen Partido Liberacion Nacional M
## PuestoCupula FechaInicio FechaSalida Provincia LugarPapeleta
## 1 Candidatura presidencial 1/1/1982 2/7/1982 NA
## 2 Candidatura presidencial 8/7/1985 2/2/1986 NA
## 3 Candidatura presidencial 8/7/1985 2/2/1986 NA
## 4 Candidatura presidencial 10/1/1989 2/4/1990 NA
## 5 Candidatura presidencial 10/1/1989 2/4/1990 NA
## 6 Candidatura presidencial 10/1/1993 2/6/1994 NA
## DiasPuesto InicioPartido Final.Partido DiasTotalPartido GradoPermanencia
## 1 37 1/1/1982 4/30/2017 12903 0.0029
## 2 179 1/18/1984 4/30/2017 12156 0.0147
## 3 179 1/1/1982 4/30/2017 12903 0.0139
## 4 126 1/18/1984 4/30/2017 12156 0.0104
## 5 126 1/1/1982 4/30/2017 12903 0.0098
## 6 128 1/1/1982 4/30/2017 12903 0.0099
## GradoPermanenciaFinal DiasPuestoFinal PartidoPoliticoSigla
## 1 0.0029 37 PLN
## 2 0.0147 179 PUSC
## 3 0.0139 179 PLN
## 4 0.0104 126 PUSC
## 5 0.0098 126 PLN
## 6 0.0099 128 PLN# Grafico barras apiladas
ggplot(datosGenero, aes(PartidoPoliticoSigla, porcentaje, label=porcentaje)) +
geom_bar(aes(fill=Sexo, color="white"),stat = "identity", position = "stack") +
geom_text(aes(label=paste(round(porcentaje*100,0),"%",sep="")), size = 5, position = position_stack(vjust = 0.5)) +
scale_fill_manual("", values = c("F"="steelblue", "M"="grey70"), breaks=c("F", "M"), labels=c("Mujeres", "Hombres")) +
scale_color_manual("", values = "white") +
theme_minimal() +
ggtitle("Composición de las cúpulas partidarias, según sexo. 1982-2017") +
theme(axis.title = element_blank(), axis.text.y = element_blank(), axis.text.x = element_text(size = 15, face = "bold"), panel.grid.minor.y = element_blank()) +
scale_y_continuous(expand = c(0,0), breaks = seq(0,1,1)) +
theme(legend.position = "bottom", legend.text = element_text(size = 15)) +
guides(color=FALSE)
Barras flotantes:
Un ejemplo más complejo es el de barras flotantes que permite identificar el comportamiento de dos poblaciones (o grupos de interés) sobre un intervalo continúo o en el tiempo. En este caso se combina con barras horizontales coord_flip().
library(ggplot2)
library(tidyr)
library(dplyr)
library(plotly)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("SimpatiaPartidariaCR1993-2017_v6-9-17.csv", sep = ";", stringsAsFactors = F)
head(datos)## Fecha1 Fecha2 Fecha3 Fecha4 PLN PUSC PLN.PUSC Otro Ninguno
## 1 2/1/1993 February,93 febrero,93 Feb,93 60.92 38.08 99.00 1.00 0.00
## 2 5/1/1993 May,93 mayo,93 May,93 57.08 40.27 97.35 2.65 0.00
## 3 9/1/1993 September,93 septiembre,93 Sep,93 50.96 39.79 90.75 0.79 8.46
## 4 11/1/1993 November,93 noviembre,93 Nov,93 44.86 41.44 86.30 2.79 10.91
## 5 12/1/1993 December,93 diciembre,93 Dic,93 49.40 46.81 96.22 1.89 1.89
## 6 1/1/1997 January,97 enero,97 Ene,97 30.49 40.10 70.59 1.25 28.15
## X
## 1 NA
## 2 NA
## 3 NA
## 4 NA
## 5 NA
## 6 NA# Se seleccionan las columnas de interes
datos2 <- datos[-35,c(-1:-3, -7, -10)]
datos2$Fecha4 <- factor(datos2$Fecha4, levels = as.character(unique(datos2$Fecha4)))
datos3 <- gather(datos2, key=partido, value = porcentaje, -Fecha4)
datos3$porcentaje <- datos3$porcentaje/100
###### GRAFICO FLOATING BARS
# Se seleccionan las columnas de interes
datos2 <- datos[-35,c(-1:-3, -7, -10)]
datos2$Fecha4 <- factor(datos2$Fecha4, levels = as.character(unique(datos2$Fecha4)))
datos2$Ninguno <- datos2$Ninguno*-1
datos3 <- gather(datos2, key=partido, value = porcentaje, -Fecha4)
datos3$porcentaje <- datos3$porcentaje/100
# ver tabla
head(datos)## Fecha1 Fecha2 Fecha3 Fecha4 PLN PUSC PLN.PUSC Otro Ninguno
## 1 2/1/1993 February,93 febrero,93 Feb,93 60.92 38.08 99.00 1.00 0.00
## 2 5/1/1993 May,93 mayo,93 May,93 57.08 40.27 97.35 2.65 0.00
## 3 9/1/1993 September,93 septiembre,93 Sep,93 50.96 39.79 90.75 0.79 8.46
## 4 11/1/1993 November,93 noviembre,93 Nov,93 44.86 41.44 86.30 2.79 10.91
## 5 12/1/1993 December,93 diciembre,93 Dic,93 49.40 46.81 96.22 1.89 1.89
## 6 1/1/1997 January,97 enero,97 Ene,97 30.49 40.10 70.59 1.25 28.15
## X
## 1 NA
## 2 NA
## 3 NA
## 4 NA
## 5 NA
## 6 NA#GRAFICO: FINAL
ggplot(datos3, aes(Fecha4, porcentaje, fill=partido)) +
geom_col(position = "stack", width = .9) +
geom_segment(aes(x = 15.5, xend = 15.5, y=-1, yend=1.2), color="grey85", linetype="dashed") +
geom_text(aes(x=10, y=1.01, label="Alineamiento alto\ny bipartidismo"), size=6) +
geom_segment(aes(x = 36.5, xend = 36.5, y=-1, yend=1.2), color="grey85", linetype="dashed") +
geom_text(aes(x=26, y=1.01, label="Alineamiento\nmedio"), size=6) +
geom_text(aes(x=48, y=1.01, label="Alineamiento bajo\ny multipartidismo"), size=6) +
geom_hline(yintercept = .5, linetype="solid", color="red") +
geom_hline(yintercept = -.5, linetype="solid", color="red") +
coord_flip() +
scale_fill_manual("Simpatía partidaria ", values = c("PUSC"="bisque2", "PLN"="bisque3", "Otro"="bisque4","Ninguno"="grey40"), breaks=c("Ninguno", "PUSC", "PLN", "Otro", "Ninguno")) +
scale_y_continuous(expand = c(0,0), breaks = seq(-1,1,.25), limits = c(-1,1.20), labels = c("100%","75%","50%","25%","0","25%","50%","75%","100%")) +
labs(x="", y="") +
theme_classic() +
theme(axis.text.x = element_text(size = 15), axis.text.y = element_text(size = 12)) +
theme(legend.position = "bottom", legend.text = element_text(size = 20), legend.title = element_text(size = 20)) +
ggtitle("Simpatías partidarias en Costa Rica. 1993-2017")
Barras con coordenadas polar (Rose-plot):
Los gráficos de barras también pueden ser usados de otras formas al cambiar la coordenada sobre la que se plotea. El Rose-plot es un ejemplo de ello: utiliza un geom_bar combinado con coord_polar()
library(ggplot2)
library(tidyr)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("DecretosRecurridos.csv", sep = ";")
# ver tabla
head(datos)## Tipo Admitidos Rechazados
## 1 Muy alto 60 74
## 2 Alto 18 53
## 3 Medio-alto 22 23
## 4 Medio-bajo 15 30
## 5 Bajo 37 66
## 6 Muy bajo 19 26# Se trasnforma DF
datos2 <- gather(datos, Recurridos, Valor, -Tipo)
# Orden a levels de factor
datos2$Tipo <- factor(datos2$Tipo, levels = as.character(unique(datos2$Tipo)))
datos2$Recurridos <- factor(datos2$Recurridos, levels = as.character(unique(rev(datos2$Recurridos))))
# ver tabla
head(datos2)## Tipo Recurridos Valor
## 1 Muy alto Admitidos 60
## 2 Alto Admitidos 18
## 3 Medio-alto Admitidos 22
## 4 Medio-bajo Admitidos 15
## 5 Bajo Admitidos 37
## 6 Muy bajo Admitidos 19# Grafico ROSE
ggplot(datos2, aes(Tipo, Valor, fill=Recurridos)) +
geom_bar(stat="identity", width=.95,colour="black",size=0.2) +
coord_polar() +
scale_fill_manual("", values = c("Admitidos"="steelblue", "Rechazados"="grey60")) +
theme_minimal() +
labs(x="Alcance del decreto", y="Cantidad",
title="Cantidad de recursos de inconstitucionalidad contra decretos ejecutivos, por alcance,\nsegún resultado de admisibilidad de la Sala Constitucional. 1990-2017") +
theme(axis.text.x = element_text(size = 12, face = "bold"), axis.text.y = element_text(size = 12)) +
theme(axis.title = element_text(size = 13), axis.title.y = element_text(hjust = .65)) +
theme(legend.text = element_text(size = 12), legend.key.size = unit(1.3, 'lines'), legend.key = element_rect(colour = 'white', size = 1.5))
Barras con coordenadas polar (Dona o circular):
Una variación usando coord_polar() es el gráfico de dona. En el código siguiente se muestra el gráfico de barras sencillo y luego la transformación final, donde es más fácil la comparación de tiempos en el aula. Se usa el parámetro coord_polar(theta = "y"). Gráfico realizado para el Informe Estado de la Educación.
##########################################################################
# Circular bar plot: Balance uso del tiempo en aula
##########################################################################
library(ggplot2)
# Datos metidos a manos
variable <- c(rep("Métodos didácticos", 25),rep("Aprendizaje conjunto",25), rep("Tiempo lectivo neto", 50), rep("Total tiempo lectivo",100))
subvariable=c(rep("Participativo: 3%", 3),rep("Tradicional: 22%", 22), rep("Aprendizaje conjunto: 25%", 25), rep("Tiempo lectivo neto: 50%",50), rep("Total tiempo lectivo: 100%",100))
datos <- data.frame(variable,subvariable)
# Se ordenan factores
datos$variable <- factor(datos$variable, levels = unique(datos$variable)) # se ordenan factores en orden del dataframe
datos$subvariable <- factor(datos$subvariable, levels = unique(datos$subvariable)) # se ordenan factores en orden del dataframe
# ver tabla
head(datos)## variable subvariable
## 1 Métodos didácticos Participativo: 3%
## 2 Métodos didácticos Participativo: 3%
## 3 Métodos didácticos Participativo: 3%
## 4 Métodos didácticos Tradicional: 22%
## 5 Métodos didácticos Tradicional: 22%
## 6 Métodos didácticos Tradicional: 22%
# Circular bar plot
ggplot(datos, aes(x=variable, fill = subvariable)) +
geom_bar() +
coord_polar(theta = "y") + # To use a polar plot and not a basic barplot
xlab("") + ylab("") +
ggtitle("Balance general del uso del tiempo en las aulas de matemáticas. 2016") +
geom_text(data = datos, hjust = 1, size = 4, aes(x = variable, y = 0, label = variable)) +
theme_minimal() +
scale_fill_manual("Métodos didácticos:", breaks=c("Tradicional: 22%", "Participativo: 3%"),
values = c("Tradicional: 22%" = "grey60", "Participativo: 3%" = "#7CCD7C", "Aprendizaje conjunto: 25%"="#a0d0de", "Tiempo lectivo neto: 50%"="#97b5cf", "Total tiempo lectivo: 100%"="#4682B4")) +
theme(axis.text.y = element_blank() , axis.ticks = element_blank(), panel.grid.minor=element_blank(),
panel.grid.minor.x=element_blank(), panel.grid.major.x=element_blank()) +
theme(axis.text.x = element_text(size = 12, face = "bold")) +
theme(legend.title=element_text(size=13), legend.text=element_text(size=11), legend.position = "bottom") +
guides(fill = guide_legend(title.position = "top", title.hjust=.5, nrow=2))
Líneas geom_line() y geom_segment()
Lo ideal es tener como máximo 3 o 4 líneas para representar. En casos donde se requiera representar más vale la pena utilizar la opción de facetas para realizar subplots o small-multiples y ver el comporamiento de cada línea por separado.
Líneas sencillas:
Es de los gráficos más comunes, y sencillos de entender. Se pueden graficar líneas simples, o también con marcadores geom_point() como en este caso. En este ejemplo se agrega un sombreado para la primera parte del período en bipartidismo con el parámetro geom_rect(). El procedimiento es sencillo: se dibuja un rectángulo de color gris y se posiciona en el fondo del gráfico. Es preciso notar que cada uno de los tres geométricos constituyen una capa que requiere ser puesta en orden. Por ejemplo, si el rectángulo se pone de tercero en el código, estaría por encima de las otras dos capas y no permitiría ver las líneas y los puntos (marcadores). Finalmente, se agregan etiquetas de texto con annotate()
library(dplyr)
library(tidyr)
library(ggplot2)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
datos <- read.csv("BBDDLeyes1990-2017_v20-7-17.csv", sep = ";", stringsAsFactors=FALSE, header = T)
# Pasar a factor varias columnas
cols <- c("TipoLegislacion", "TipoLegislacion_2", "Derechos", "Obligaciones", "RequiereRecursos", "ContenidoFinanciero")
datos <- datos %>% mutate_each_(funs(factor(.)),cols)
#Dar formato de fechas a columnas
datos$FechaAprobacion <- as.Date(datos$FechaAprobacion, "%m/%d/%Y")
datos$Sancion <- as.Date(datos$Sancion, "%m/%d/%Y")
datos$FechaInicio <- as.Date(datos$FechaInicio, "%m/%d/%Y")
# Calcular dias de aprobacion
datos$DuracionDias2 <- datos$FechaAprobacion - datos$FechaInicio #nueva fecha de duracion dias
datos$ControlDias <- datos$DuracionDias - datos$DuracionDias2
# Columna de Duracion en Años
datos$DuracionAño <- datos$DuracionDias2/365
# Se corta nombre de Legislatura con expresiones regulares (REGEX) y se da formato a factores en orden para gráficos
datos$Legislatura2 <- gsub("*\\-[0-9]{2}", "/", datos$Legislatura)
datos$Legislatura2 <- gsub("^[0-9]{2}", "", datos$Legislatura2)
# Factor en orden
datos$Legislatura2 <- factor(datos$Legislatura2, levels = unique(datos$Legislatura2))
# Se crea columna de Administracion Aprobacion
datos$AdmAprobacion <- ifelse(datos$FechaAprobacion < "1994-05-1", "Calderón",
ifelse(datos$FechaAprobacion < "1998-05-1", "Figueres",
ifelse(datos$FechaAprobacion < "2002-05-1", "Rodríguez",
ifelse(datos$FechaAprobacion < "2006-05-1", "Pacheco",
ifelse(datos$FechaAprobacion < "2010-05-01", "Arias(2)",
ifelse(datos$FechaAprobacion < "2014-05-1", "Chinchilla",
ifelse(datos$FechaAprobacion < "2018-05-1", "Solís", 0)))))))
# Se crea una columna para identificar cuando una ley es aprobada dentro del periodo de mandato del gobierno de turno
datos$LegPropia <- ifelse(datos$AdministracionInicio == datos$AdmAprobacion, "propia", "otra")
####################################
#Legislacion segun IniciativaPoder
####################################
# Se filtran los datos para sacar la proporcion de leyes en cada año segun Iniciativa
datosIniciativa <- datos %>% group_by(Legislatura, IniciativaPoder) %>% summarise (n = n()) %>%
mutate(porcentaje = round(n / sum(n)*100))
# Factor en orden
datosIniciativa$Legislatura <- factor(datosIniciativa$Legislatura, levels = unique(datosIniciativa$Legislatura))
# ver tabla
head(datosIniciativa)## # A tibble: 6 x 4
## # Groups: Legislatura [3]
## Legislatura IniciativaPoder n porcentaje
## <fct> <chr> <int> <dbl>
## 1 1990-1991 Ejecutivo 38 41
## 2 1990-1991 Legislativo 55 59
## 3 1991-1992 Ejecutivo 30 51
## 4 1991-1992 Legislativo 29 49
## 5 1992-1993 Ejecutivo 26 58
## 6 1992-1993 Legislativo 19 42# GRAFICO de lineas
ggplot(datosIniciativa, aes(x=Legislatura, y=porcentaje)) +
geom_rect(aes(xmin=-Inf,xmax=12,ymin=-Inf, ymax=Inf), fill="grey90", alpha =.5) +
geom_point(aes(group=IniciativaPoder, color=IniciativaPoder), size=2) +
geom_line(aes(group=IniciativaPoder, color=IniciativaPoder), size=1.5) +
annotate("text", x=6, y=95, label= "Bipartidismo", size=3, fontface="bold") +
annotate("text", x=20, y=95, label= "Multipartidismo", size=3, fontface="bold") +
scale_color_manual("", breaks= c("Ejecutivo", "Legislativo"), values = c("Ejecutivo"="Steelblue", "Legislativo"="goldenrod2", "Iniciativa popular"="white")) +
scale_y_continuous(breaks = seq(0,100,20), limits = c(0,100), expand = c(0,0)) +
scale_x_discrete(expand = c(0,.5)) +
labs(x= "\nLegislatura", y="Porcentaje") +
theme_classic() +
theme(axis.title = element_text(size = 13), axis.text = element_text(size = 12), axis.text.x = element_text(angle = 90, hjust = .9, vjust = .8)) +
theme(legend.position = "bottom", legend.text = element_text(size = 13))
Líneas con facetas comparadas:
Se representa en small-multiples (gráficos pequeños separados) el comporamiento de cada línea y a la vez se pueden comparar. En este caso se utiliza el nombre del Estado en Alemania para representar, mediante facetas, la participación electoral histórica en cada uno con facet_wrap(~nombre). Este gráfico contiene las siguientes características:
- Preparación de los datos (data wrangling). Ver código.
- Incluye líneas promedio de participación electoral nacional en color rojo, lo cuál permite ver el nivel en el que se mueve cada Estado.
- Incluye todos los Estados y los datos a partir de la fecha de creación de cada uno.
- Facetas comparadas.
- Edición de las escalas para apreciar las fechas y también los valores de participación electoral (ver eje Y).
Gráfico elaborado para una presentación sobre elecciones en Alemania para la UCR (2017).
library(tidyr)
library(dplyr)
library(ggplot2)
setwd("~/Dropbox/PEN/BigData/EleccionesAlemania/Procesamientos_R")
Congreso <- read.csv("ComposicionParlamento.csv", sep = ";", stringsAsFactors = F)
Turnout <- read.csv("VoterTurnout.csv", sep = ";", stringsAsFactors = F)
## Sustituir sigla Brandenbur (BB) por "BR" para hacer merge con DF de mapa mas adelante
Congreso[Congreso == "BB"] <- "BR"
Turnout[Turnout == "BB"] <- "BR"
#Variables de conteo
Congreso$conteo <- 1
Turnout$conteo <- 1
# Filtrar y agrupar DF por partido ganador en Second Vote
PartyWinner <- Congreso %>% select(state, year, party, SecondVotes) %>% group_by(state, year) %>% summarize(Ganador = party[which.max(SecondVotes)])
# Se unen los dos datasets en un solo DF
datos <- merge(PartyWinner, Turnout, by=c("state","year"))
colnames(datos)[6] <- "InvalidVotes"
datos$conteo <- 1
###########################################################
# Se establecen las etiquetas de cada Estado, con la base de datos del mapa de Alemania.
###########################################################
library(sp)
library(ggplot2)
library(rgdal)
library(rgeos)
library(maptools)
library(RColorBrewer)
library(stringr)
setwd("~/Dropbox/PEN/BigData/EleccionesAlemania/Procesamientos_R")
## Leer el archivo mapa con los Estados de Alemania descargado de internet: http://www.gadm.org/country
mapa <- readRDS("DEU_adm1.rds")
# add to data a new column termed "id" composed of the rownames of data
mapa@data$id <- rownames(mapa@data)
# create a data.frame from our spatial object
mapaPoints <- fortify(mapa, region = "id")
# merge the "fortified" data with the data from our spatial object
mapaDF <- merge(mapaPoints, mapa@data, by = "id")
## Variable para estados del Este y Oeste
mapaDF$region <- ifelse(mapaDF$ID_1 == 3 | mapaDF$ID_1 == 4 |mapaDF$ID_1 == 8 |mapaDF$ID_1 == 13 |mapaDF$ID_1 == 14 |mapaDF$ID_1 == 16, "Este", "Oeste")
#Etiquetas DF para merge con DF de Congreso y Turnout (arriba)
etiquetas <- data.frame(nombre=unique(mapaDF$NAME_1), sigla=unique(mapaDF$HASC_1))
etiquetas$state <- sub('.*\\.', '', etiquetas$sigla)
###########################################################
# Se hace el gráfico de participación electoral con facetas por Estado
###########################################################
Participacion <- Turnout %>% select(year, state, RegisteredElectors, Voters, conteo) %>% group_by(year, state, RegisteredElectors, Voters, conteo) %>% summarise(Total=sum(conteo))
Participacion$porcentaje <- Participacion$Voters/Participacion$RegisteredElectors
Participacion$porcentaje2 <- Participacion$porcentaje*100
PartEstado <- Participacion[,c(-3:-7)]
PartEstadoMatrix <- spread(PartEstado,state,porcentaje2)
# Se pega nombres del DF etiquetas creado anteriormente)
PartEstado <- merge(PartEstado, etiquetas, by="state")
PartEstado$nombre <- factor(PartEstado$nombre, levels = c("Baden-Württemberg","Bayern","Bremen", "Hessen","Hamburg", "Niedersachsen","Nordrhein-Westfalen","Rheinland-Pfalz","Schleswig-Holstein","Saarland","Berlin","Brandenburg","Mecklenburg-Vorpommern","Sachsen","Sachsen-Anhalt","Thüringen"))
# ver tabla
head(PartEstado)## state year porcentaje2 nombre sigla
## 1 BE 2009 70.91734 Berlin DE.BE
## 2 BE 1990 80.55358 Berlin DE.BE
## 3 BE 1998 81.07141 Berlin DE.BE
## 4 BE 2013 72.45089 Berlin DE.BE
## 5 BE 2005 77.38716 Berlin DE.BE
## 6 BE 2002 77.62895 Berlin DE.BE# GRafico con facetas
ggplot(PartEstado, aes(year, porcentaje2)) +
geom_line(size=1, color="steelblue") +
facet_wrap(~nombre) +
geom_hline(yintercept = 70, linetype="dashed", color="red") +
scale_x_continuous(breaks=seq(1950,2015,10)) +
theme_bw() +
theme(panel.grid.minor = element_blank()) +
labs(x="\nAño de la elección", y="Porcentaje de participación",
title="Participación electoral por Estado. Alemania, 1953-2013") +
theme(axis.title = element_text(size = 13), axis.text = element_text(size = 10))
Líneas con selector de tiempo y pronósticos (series de tiempo):
El paquete dygraphs permite realizar gráficos de líneas más sofisticados, en particular para análisis de series de tiempo. Es interacttivo de manera que, con el cursor, es posible ver los datos de cada punto en la línea. Incluye un selector de tiempo para hacer zoom. También distingue la línea de datos reales de la línea de pronóstico (en sombreado), entre otros detalles de graficación. En este caso se usa el ejemplo de protesta ciudadana entre enero de 2005 y marzo de 2016 y se pronostica el comportamiento de los datos para un año (hasta marzo de 2017). El código incluye el análisis de series de tiempo con un modelo ARIMA.
suppressMessages(library(xts))
suppressMessages(library(dygraphs))
suppressMessages(library(itsmr))
suppressMessages(library(forecast))
suppressMessages(library(lubridate))
setwd("~/Dropbox/PEN/BigData/AccionesColectivas/SerieTiempo_AC_2016/AC-SeriesTiempo_SGC/AC-SeriesTiempos_R")
datos <- read.csv("AC_Proy2016LGS(v17-8-2016).csv",header=TRUE,sep=";")
# Se pasa a serie de tiempo
AC.Solis3<-ts(datos[,2],start=c(2005,1),freq=12)
## MODELO 1
# Se pasa auto.arima para definir parámetros del modelo ARIMA
auto.arima(AC.Solis3)## Series: AC.Solis3
## ARIMA(1,1,1)(1,0,2)[12] with drift
##
## Coefficients:
## ar1 ma1 sar1 sma1 sma2 drift
## 0.1374 -0.8497 0.8621 -0.7654 0.1627 -0.1686
## s.e. 0.1107 0.0574 0.1834 0.2196 0.1609 0.3915
##
## sigma^2 estimated as 146.7: log likelihood=-524.38
## AIC=1062.76 AICc=1063.65 BIC=1083.04# Se corre el modelo con los parámetros del auto.arima y la predicción a 12 meses
mod<-arima(AC.Solis3,order=c(3,1,1),seasonal=list(order=c(1,0,2),period=12))
pred<-predict(mod,n.ahead=12)
## Gráfico con DYGRAPH
# Se definen los vectores de predicción y límites para AC.Solis3
preds.AC.Solis3<-pred$pred
LimInf.AC.Solis3<-preds.AC.Solis3-pred$se
LimSup.AC.Solis3<-preds.AC.Solis3+pred$se
# Se crean los vectores de fechas para per_1.AC.Solis3 y per_2.AC.Solis3
per_1.AC.Solis3<-seq(as.Date("2005-1-1"),as.Date("2016-3-1"),"month")
per_2.AC.Solis3<-seq(as.Date("2016-4-1"),as.Date("2017-3-1"),"month")
# Se juntan todas las series y se convierten a XTS
todas.series<-cbind(AC=xts(AC.Solis3,order.by=per_1.AC.Solis3),LimInf=xts(LimInf.AC.Solis3,order.by=per_2.AC.Solis3),Pronostico=xts(preds.AC.Solis3,order.by=per_2.AC.Solis3),LimSup=xts(LimSup.AC.Solis3,order.by=per_2.AC.Solis3))
# Se hace el gráfico DYGRAPH
dygraph(todas.series,main="AC",ylab="Cantidad de protestas")%>%
dySeries(c("LimInf", "Pronostico", "LimSup"), label = "Pronóstico")%>%
dyRangeSelector(height = 20, strokeColor = "")%>%
dyOptions(axisLineColor = "navy",
gridLineColor = "lightblue",
strokeWidth = 3)Slopegraph:
Este es un gráfico desarrollado por Edward Tufte en su libro de 1983 The Visual Display of Quantitative Information. El slopegraph se puede hacer con R, pero requiere bastante trabajo manual debido a que no hay un geométrico que permita generarlo de manera automático. Implica la combinación del geom_line() y el geom_point() y sobre todo la ubicación de los valores de forma manual en el plano de graficación. Además, requiere una modificación sustantiva al tema theme() para generar el fondo blanco. No obstante, vale la pena el trabajo de “carpintería” porque es una visualización que en un sólo plano logra representar varios atributos. De acuerdo con Tufte, este tipo de gráficos permite mostrar:
- La jerarquía de los valores en cada uno de los ejes.
- Los valores asociados para cada punto de interés.
- El cambio de los valores que tuvo cada punto de interés en el tiempo.
- Cómo se compara el cambio de cada punto de interés, con los otros puntos graficados.
- Variaciones notables en el comportamiento de los datos.
Acá se utiliza para ejemplificar las variaciones en el empleo por ramas de actividad en Guanacaste.
#############################################################
# Variacion del empleo por ramas de actividad en Guanacaste
############################################################
library(readr)
library(dplyr)
library(ggplot2)
library(magrittr)
library(tidyr)
library(scales)
setwd("~/Dropbox/PEN/BigData/Equidad_SGC/Inf23")
# Se hace el DF
datos <- read.csv("Act_Guanacaste.csv", sep = ";", dec = ",", stringsAsFactors = F)
# Se cambia etiqueta de Agropecuario
datos$Rama <- gsub("Agropecuario", " Sector agropecuario", datos$Rama)
# Etiquetas se hacen a mano para luego incluir en el gráfico
datos$etiqueta1 <- ifelse(datos$Fecha == 2001 & datos$Rama!= "Resto de actividades" & datos$Rama!= "Industria manufacturera" & datos$Rama!= "Construcción" & datos$Rama!= "Enseñanza" & datos$Rama!= "Comercio",paste(unique(datos$Rama), datos$Porcentaje, sep=": "), "")
datos$etiqueta2 <- ifelse(datos$Fecha == 2001 & datos$Rama== "Resto de actividades", paste(unique(datos$Rama), datos$Porcentaje, sep=": "), "")
datos$etiqueta3 <- ifelse(datos$Fecha == 2001 & datos$Rama== "Industria manufacturera", paste(unique(datos$Rama), datos$Porcentaje, sep=": "), "")
datos$etiqueta4 <- ifelse(datos$Fecha == 2001 & datos$Rama== "Construcción", paste(unique(datos$Rama), datos$Porcentaje, sep=": "), "")
datos$etiqueta5 <- ifelse(datos$Fecha == 2001 & datos$Rama== "Enseñanza", paste(unique(datos$Rama), datos$Porcentaje, sep=": "), "")
datos$etiqueta6 <- ifelse(datos$Fecha == 2001 & datos$Rama== "Comercio", paste0(unique(datos$Rama), ": ",datos$Porcentaje,".0"), "") #Este con paste0 por el formato del número
datos$etiqueta7 <- ifelse(datos$Fecha == 2016 & datos$Rama!= "Enseñanza" & datos$Rama!= "Construcción" & datos$Rama!= "Industria manufacturera" & datos$Rama!= "Servicio doméstico",datos$Porcentaje,"")
datos$etiqueta8 <- ifelse(datos$Fecha == 2016 & datos$Rama== "Industria manufacturera",paste0(datos$Porcentaje,".0"),"") # con paste para ponerle el cero a decimal a mano
datos$etiqueta9 <- ifelse(datos$Fecha == 2016 & datos$Rama== "Construcción",datos$Porcentaje, "")
datos$etiqueta10 <- ifelse(datos$Fecha == 2016 & datos$Rama== "Enseñanza",paste0(datos$Porcentaje,".0"),"") # con paste para ponerle el cero a decimal a mano
datos$etiqueta11 <- ifelse(datos$Fecha == 2016 & datos$Rama== "Servicio doméstico",paste0(datos$Porcentaje,".0"),"") # con paste para ponerle el cero a decimal a mano
# ver tabla
head(datos)## Rama Fecha Porcentaje etiqueta1
## 1 Sector agropecuario 2001 25.3 Sector agropecuario: 25.3
## 2 Industria manufacturera 2001 6.6
## 3 Construcción 2001 6.4
## 4 Comercio 2001 16.0
## 5 Hoteles y restaurantes 2001 9.4 Hoteles y restaurantes: 9.4
## 6 Enseñanza 2001 6.4
## etiqueta2 etiqueta3 etiqueta4 etiqueta5
## 1
## 2 Industria manufacturera: 6.6
## 3 Construcción: 6.4
## 4
## 5
## 6 Enseñanza: 6.4
## etiqueta6 etiqueta7 etiqueta8 etiqueta9 etiqueta10 etiqueta11
## 1
## 2
## 3
## 4 Comercio: 16.0
## 5
## 6## GRAFICO
ggplot(datos) +
geom_line(aes(x = as.factor(Fecha), y = Porcentaje, group = Rama, color = Rama), size = 2) +
geom_point(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama), size = 4) +
theme_minimal() +
scale_color_brewer(palette = "Dark2") +
xlab("") +
ggtitle("Variaciones en el empleo por ramas de actividad en Guanacaste, 2001-2016") +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta1),size = 5, hjust = 1.1) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta2),size = 5, hjust = 1.07) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta3),size = 5, hjust = 1.07, vjust=-.5) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta4),size = 5, hjust = 1.1) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta5),size = 5, hjust = 1.11, vjust=2) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta6),size = 5, hjust = 1.15) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta7),size = 5, hjust = -.4) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta8),size = 5, hjust = -.6) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta9),size = 5, hjust = -.6, vjust=1) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta10),size = 5, hjust = -.6, vjust=0) +
geom_text(aes(x = as.factor(Fecha), y = Porcentaje, color = Rama, label = etiqueta11),size = 5, hjust = -.4) +
theme(axis.text.x = element_text(size = 18, face = "bold")) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank()) 
Segmentos y puntos (Lollipop):
Este combina segmentos y puntos en un gráfico que permite visualizar brechas entre dos valores o momentos en el tiempo. Se puede hacer en horizontal o vertical cambiando las coordenadas sobre las que se plotea coord_flip() como en este caso. Notar que cada segmento tiene un punto de inicio y otro punto final en el código. La preparación de los datos facilita la elaboración de este tipo de gráficos (ver muestra de la base de datos).
library(ggplot2)
library(dplyr)
library(scales)
library(tidyr)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
datos <- read.csv('OfertaDemandaLeg.csv', sep = ";")
head(datos)## Periodo Demandada Aprobada
## 1 2010-2011 60 14
## 2 2011-2012 74 10
## 3 2012-2013 103 22
## 4 2013-2014 67 21
## 5 2014-2015 86 7
## 6 2015-2016 103 8#Grafico
ggplot(datos, aes(x=Periodo)) +
geom_segment(aes(x=Periodo, y=Demandada, xend=Periodo, yend=Aprobada),size = .7, linetype=1) +
geom_point(aes(y=Aprobada, colour="Aprobada"),size = 12) +
geom_point(aes(y=Demandada, colour= "Demandada"),size = 12) +
geom_text(aes(y=Aprobada, label= Aprobada),hjust=0.5, vjust=0.5, color = "white", fontface = "bold")+
geom_text(aes(y=Demandada, label=Demandada),hjust=0.5, vjust=0.5, color = "white", fontface = "bold")+
coord_flip() +
scale_colour_manual("", values = c("Aprobada" = "steelblue", "Demandada" = "grey50")) +
ylab("Cantidad de proyectos en agenda") +
xlab("Legislatura") +
ggtitle("Comparación entre la agenda demandada y la aprobada, según legislatura") +
theme(legend.text = element_text(colour="black", size = 10)) +
theme(axis.text.x = element_text(color = "white"), axis.ticks.x = element_blank(), axis.text.y = element_text(size = 13)) +
theme(axis.title = element_text(size = 13)) +
theme(panel.grid.major.y = element_line(colour = "grey95")) +
theme(legend.key = element_rect(fill = "white"), legend.position = "bottom", legend.text = element_text(size = 13)) +
theme(panel.background = element_rect(fill = "white")) +
theme(axis.line.x = element_line(colour = "black")) +
theme(axis.line.y = element_line(colour = "black"))
Puntos geom_point()
Los gráficos de puntos pueden ser sencillos para comparar valores sobre un continuo, o bien para denotar y comparar tamaños de variables con escalas muy diferentes. Como en otros casos, los colores de los puntos suelen ser muy útiles para representar atributos particulares de los datos.
Puntos comparados:
Sobre un mismo eje continúo, es posible representar varios puntos para comparar valores sobre momentos de tiempo distinto. Este tipo de gráficos además da la oportunidad de cambiar el marcador de puntos a otras formas. el siguente gráfico de la participación electoral en elecciones locales utiliza cuadros en lugar de puntos, de acuerdo con el parámetro shape = 15.
library(ggplot2)
setwd("~/Dropbox/PEN/Informe XXII_(22)/EleccionesMunicipales2016/IndicadoresElectorales")
datos <- read.csv("IndicadoresElectorales_Consolidado(v1-7-16).csv", sep = ';', dec='.')
# ver tabla
head(datos)## Cantón Abs2002 Abs2006 Abs2010 Abs2016 X
## 1 San José 82.9 88.1 81.6 73.6 81.6
## 2 Escazú 79.2 77.6 72.8 61.1 72.7
## 3 Desamparados 87.4 84.9 84.3 75.7 83.1
## 4 Puriscal 70.8 60.4 68.3 61.9 65.4
## 5 Tarrazú 71.9 65.9 63.8 60.9 65.6
## 6 Aserrí 77.5 76.9 70.8 71.7 74.2ggplot(data = datos, aes(y=reorder(factor(Cantón),Abs2016))) +
geom_point(aes(x=Abs2002, colour="2002"),size = 1.5, shape = 15) +
geom_point(aes(x=Abs2006, colour= "2006"),size = 1.5, shape = 15) +
geom_point(aes(x=Abs2010, colour= "2010"),size = 1.5, shape = 15) +
geom_point(aes(x=Abs2016, colour= "2016"),size = 1.5, shape = 15) +
scale_x_continuous(breaks=seq(0, 90, 15), limits=c(0, 90), expand = c(0, 0)) +
scale_colour_manual("Abstencionismo", values = c("2002" = "blue", "2006" = "green", "2010" = "red", "2016" = "black")) +
ylab("Cantones") +
xlab("\nPorcentaje de abstencionismo") +
ggtitle("Abstencionismo en elecciones municipales, según cantón. En porcentajes") +
theme(axis.text.x = element_text(angle=0, hjust = .5)) +
theme(panel.grid.major.y = element_line(colour = "grey95")) +
theme(legend.key = element_rect(fill = "white")) +
theme(panel.background = element_rect(fill = "white")) +
theme(axis.line.x = element_line(colour = "black")) +
theme(axis.line.y = element_line(colour = "black")) +
guides(fill = FALSE)
Puntos comparados (ranking):
También es posible definir gráficos de puntos que representen prioridades de orden combinados con color. Nótese que en este caso se requirió filtrar los datos para crear categorías lo más reducidas posibles y lograr apreciar las diferencias por color.
library(tidyr)
library(ggplot2)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
datos <- read.csv("ProyectosDemandados2011-2016_v14-08-17.csv", sep = ";", stringsAsFactors = F, check.names=FALSE)
datos <- gather(datos, key=año, value = proyecto, -Posicion)
datos$DH <- ifelse(datos$proyecto == "Reforma fiscal", "Fiscal",
ifelse(datos$proyecto == "Reforma financiera", "Fiscal",
ifelse(datos$proyecto == "Solidaridad tributaria", "Fiscal",
ifelse(datos$proyecto == "Impuesto bienes inmuebles", "Fiscal",
ifelse(datos$proyecto == "Impuesto renta", "Fiscal",
ifelse(datos$proyecto == "Transparencia fiscal", "Fiscal",
ifelse(datos$proyecto == "Gestión tributaria", "Fiscal",
ifelse(datos$proyecto == "Impuesto venta", "Fiscal",
ifelse(datos$proyecto == "Exención renta pensionados", "Fiscal",
ifelse(datos$proyecto == "Exenc. fiscales", "Fiscal",
ifelse(datos$proyecto == "Contención gasto", "Fiscal",
ifelse(datos$proyecto == "IVA", "Fiscal",
ifelse(datos$proyecto == "Fraude fiscal", "Fiscal",
ifelse(datos$proyecto == "Impuesto Pers. Jurídicas", "Fiscal",
ifelse(datos$proyecto == "Reforma legislativa", "Reforma AL",
ifelse(datos$proyecto == "Entrabamiento político", "Reforma AL",
ifelse(datos$proyecto == "Salarios diputados", "Reforma AL",
ifelse(datos$proyecto == "Credencial diputados", "Reforma AL",
ifelse(datos$proyecto == "Control legislativo", "Reforma AL",
ifelse(datos$proyecto == "Calidad legislación", "Reforma AL",
ifelse(datos$proyecto == "Reglamento AL", "Reforma AL",
ifelse(datos$proyecto == "Jubilación anticipada", "Contención gasto",
ifelse(datos$proyecto == "Incentivos médicos", "Contención gasto",
ifelse(datos$proyecto == "Empleo público", "Contención gasto",
ifelse(datos$proyecto == "Contención gasto", "Contención gasto",
ifelse(datos$proyecto == "Pensiones PJ", "Contención gasto",
ifelse(datos$proyecto == "Pensiones IVM", "Contención gasto", "Otro")))))))))))))))))))))))))))
datos$Posicion <- factor(datos$Posicion, levels = as.character(rev(unique(datos$Posicion))))
datos$DH <- factor(datos$DH, levels = c("Fiscal", "Reforma AL","Contención gasto","Otro"))
# ver tabla
head(datos)## Posicion año proyecto DH
## 1 1 2006 Libre comercio Otro
## 2 2 2006 Reforma fiscal Fiscal
## 3 3 2006 Obra pública Otro
## 4 4 2006 Energía y Telecom Otro
## 5 5 2006 Reforma legislativa Reforma AL
## 6 6 2006 Educación Otro# RANKING CHART: sin lineas de conextion
# Gráfico (colores)
ggplot(datos, aes(x = as.factor(año))) +
geom_point(aes(y = Posicion, fill=DH), color="black", pch=21, size = 10) +
theme_minimal(base_size = 12) +
scale_fill_manual("Tema: ", values = c("Fiscal"="steelblue", "Reforma AL"="limegreen", "Contención gasto"="orange3", "Otro"="white"), label=c("Reforma\ntributaria b/ ", "Reformas en\nel Congreso c/ ", "Contención\ndel gasto d/ ", "Otro e/")) +
labs(x="\nAño", y="Posición\n",
title="Proyectos de ley más demandados por la sociedad civil, según tema",
subtitle="(posición según frecuencia)") +
theme(axis.title = element_text(size = 15), axis.text = element_text(size = 14, face = "bold")) +
theme(legend.position = "bottom", legend.text = element_text(size = 14), legend.title = element_text(size = 14))
Puntos comparados por tamaño (gráfico de burbujas):
Los puntos se pueden combinar con tamaño y color para comparar valores de diversas categorías. El siguiente caso, sobre decretos ejecutivos, representa con color el alcance en el tipo del decreto, y el tamaño de cada círculo denota la cantidad para cada administración. Es una forma sencilla de apreciar las diferencias. En este caso se aplican dos transformaciones. La primera sobre los datos porque la información no estaba en formato tidy. La segunda ocurre sobre las escalas para dar un tamaño proporcional a cada burbuja scale_size_area(max_size = 44).
library(ggplot2)
library(tidyr)
library(plotly)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("DecretosAlcance.csv", sep = ";")
# Se transforma DF
datos2 <- gather(datos, Administracion, Valor, -Alcance)
# Cambiar nombre a Administracion
datos2$Administracion <- ifelse(datos2$Administracion == "Calderón.Fournier", "Calderón",
ifelse(datos2$Administracion == "Figueres.Olsen", "Figueres",
ifelse(datos2$Administracion == "Rodriguez.Echeverría", "Rodríguez",
ifelse(datos2$Administracion == "Pacheco.de.la.Esperiella", "Pacheco",
ifelse(datos2$Administracion == "Arias.Sánchez", "Arias",
ifelse(datos2$Administracion == "Chinchilla.Miranda", "Chinchilla",
ifelse(datos2$Administracion == "Solís.Rivera", "Solís", "ERROR")))))))
# Factor y levels
datos2$Alcance <- factor(datos2$Alcance, levels = as.character(rev(unique(datos2$Alcance))), labels = c("Muy bajo", "Bajo", "Medio bajo", "Medio alto", "Alto", "Muy alto"))
datos2$Administracion <- factor(datos2$Administracion, levels = as.character(unique(datos2$Administracion)))
# Color a tipo de decreto
datos2$Rango <- ifelse(datos2$Alcance == "Muy alto" | datos2$Alcance == "Alto", "Alto",
ifelse(datos2$Alcance == "Medio alto" | datos2$Alcance == "Medio bajo", "Medio",
ifelse(datos2$Alcance == "Bajo" | datos2$Alcance == "Muy bajo", "Bajo", "ERROR")))
datos2$Rango <- factor(datos2$Rango, levels = c("Alto", "Medio", "Bajo"))
# ver tabla
head(datos2)## Alcance Administracion Valor Rango
## 1 Muy alto Calderón 236 Alto
## 2 Alto Calderón 86 Alto
## 3 Medio alto Calderón 242 Medio
## 4 Medio bajo Calderón 188 Medio
## 5 Bajo Calderón 405 Bajo
## 6 Muy bajo Calderón 1059 Bajo# Grafico de bubble proporcional
ggplot(datos2, aes(Administracion, Alcance)) +
geom_point(aes(size=Valor, color=Rango)) +
scale_color_manual("", values = c("Alto"="Steelblue", "Medio"="wheat2", "Bajo"="Grey40")) +
geom_text(aes(label=Valor), colour="black") +
scale_size_area(max_size = 44) +
guides(size=FALSE) +
theme_minimal() +
theme(axis.title = element_text(size = 14), axis.text = element_text(size = 13)) +
theme(legend.position = "bottom", legend.title = element_text(size = 14), legend.text = element_text(size = 14)) +
labs(x="\nAdministración", y="Alcance del decreto\n",
title="Cantidad de decretos por administración, según alcance",
subtitle="(primero, segundo y tercer año de gobierno)") +
guides(color=guide_legend(override.aes = list(size=7)))
Puntos con facetas:
También es posible usar puntos con facetas para contar historias más complejas. Por ejemplo, el de la trayectoría de líderes políticos en puestos de la cúpula. Acá se distinguen cuatro atributos distintos:
- el partido político
- el sexo
- el tiempo en la cúpula partidaria de cada persona
- etiquetas de personas con más tiempo en cada caso
library(ggplot2)
library(dplyr)
library(tidyquant)
library(ggrepel) # editar etiquetas en gráfico
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("CupulasPartidarias_v19-07-17.csv", sep = ";", stringsAsFactors = F)
# Se limpia DF
datos <- datos %>% mutate(GradoPermanenciaFinal=replace(GradoPermanencia, GradoPermanencia == "#VALUE!", NA))
## Se limpia variable Dias Puesto
datos <- datos %>% mutate(DiasPuestoFinal=replace(DiasPuesto, DiasPuesto == "Cubierto", NA))
# Partidos a siglas
datos$PartidoPoliticoSigla <- ifelse(datos$PartidoPolitico == "Partido Liberacion Nacional", "PLN",
ifelse(datos$PartidoPolitico == "Partido Unidad Social Cristiana", "PUSC",
ifelse(datos$PartidoPolitico == "Partido Movimiento Libertario", "ML",
ifelse(datos$PartidoPolitico == "Partido Renovacion Costarricense", "RC",
ifelse(datos$PartidoPolitico == "Partido Accion Ciudadana", "PAC",
ifelse(datos$PartidoPolitico == "Partido Frente Amplio", "FA",
ifelse(datos$PartidoPolitico == "Partido Accesibilidad sin Exclusion", "PASE", "ERROR")))))))
# Se da formato numerico
datos$GradoPermanenciaFinal <- as.numeric(datos$GradoPermanenciaFinal)
datos$DiasPuestoFinal <- as.numeric(datos$DiasPuestoFinal)
# Se agrupan los datos por lider y partido (tiempo en dias: absolutos)
datosAgrupadosAbsoluto <- subset(datos) %>% select(NombreLider, Sexo, DiasPuestoFinal, PartidoPoliticoSigla) %>%
group_by(NombreLider, Sexo, PartidoPoliticoSigla) %>% summarise(Total=(sum(DiasPuestoFinal, na.rm = TRUE)))
#se ordena el DF y se da orden a partidos
datosAgrupadosAbsoluto <- arrange(datosAgrupadosAbsoluto, desc(Total))
datosAgrupadosAbsoluto$PartidoPoliticoSigla <- factor(datosAgrupadosAbsoluto$PartidoPoliticoSigla, levels = c("RC", "ML", "PASE","PUSC", "PLN", "PAC", "FA"))
# Se pasa dias a años
datosAgrupadosAbsoluto$TotalAños <- datosAgrupadosAbsoluto$Total/365
# Se ajustan los nombres de los lideres con mas tiempo para graficar
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Jose Maria Figueres Ferrer"] <- "José María Figueres"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Francisco Antonio Pacheco Fernandez"] <- "Francisco Antonio Pacheco"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Rolando Gonzalez Ulloa"] <- "Rolando González"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Rolando Araya Monge"] <- "Rolando Araya"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Justo Orozco Alvarez"] <- "Justo Orozco"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Otto Guevara Guth"] <- "Otto Guevara"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Jose Maria Villalta Florez-Estrada"] <- "José María Villalta"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Jose Merino del Rio"] <- "José Merino"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Patricia Mora Castellanos"] <- "Patricia Mora"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Otton Solis Fallas"] <- "Ottón Solís"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Margarita Bolaños Arquin"] <- "Margarita Bolaños"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Sadie Bravo Perez"] <- "Sadie Bravo"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Luis Fishman Zonzinski"] <- "Luis Fishman"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Lorena Vasquez Badilla"] <- "Lorena Vasquez"
datosAgrupadosAbsoluto[datosAgrupadosAbsoluto == "Oscar Andres Lopez Arias"] <- "Óscar López"
# ver tabla
head(datosAgrupadosAbsoluto)## # A tibble: 6 x 5
## # Groups: NombreLider, Sexo [6]
## NombreLider Sexo PartidoPoliticoSigla Total TotalAños
## <chr> <chr> <fct> <dbl> <dbl>
## 1 Justo Orozco M RC 8002 21.9
## 2 Otto Guevara M ML 7846 21.5
## 3 Jimmy Soto Solano M RC 4649 12.7
## 4 Óscar López M PASE 4624 12.7
## 5 Lorena Vasquez F PUSC 3321 9.10
## 6 José María Figueres M PLN 3122 8.55## Grafico cupulas con puntos por lider y facet_grid (Para plataforma web. Tiempo absoluto en años)
ggplot(datosAgrupadosAbsoluto, aes(TotalAños, Sexo, fill=Sexo)) +
geom_point(position = "jitter", size=5, pch=21, color="black", alpha=.8) +
facet_grid(PartidoPoliticoSigla~., switch = "y") +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños >21.9), aes(label=NombreLider), size=3) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños >20 & TotalAños < 21.9), aes(label=NombreLider), size=3, nudge_y = -.3) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 12 & PartidoPoliticoSigla == "PASE"), aes(label=NombreLider), size=3, nudge_x = 1.1, nudge_y = .2) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 9 & PartidoPoliticoSigla == "PUSC"), aes(label=NombreLider), size=3, nudge_x = 1.4) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 6.7 & TotalAños < 9 & PartidoPoliticoSigla == "PUSC"), aes(label=NombreLider), segment.alpha = 0, size=3, nudge_x = 1.3, nudge_y = .2) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 8.5 & PartidoPoliticoSigla == "PLN"), aes(label=NombreLider), size=3, segment.alpha = 0, nudge_x = 1.7, nudge_y = .3) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 8.4 & TotalAños < 8.5 & PartidoPoliticoSigla == "PLN"), aes(label=NombreLider), size=3, segment.alpha = 0, nudge_x = 2.2, nudge_y = -.2) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 8 & PartidoPoliticoSigla == "PAC"), aes(label=NombreLider), size=3, segment.alpha = 0, nudge_x = .9) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 6.7 & TotalAños < 8 & PartidoPoliticoSigla == "PAC"), aes(label=NombreLider), size=3, nudge_x = 1.1, nudge_y = .3) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 6 & TotalAños < 6.7 & PartidoPoliticoSigla == "PAC"), aes(label=NombreLider), size=3, nudge_x = 1, nudge_y = -.1) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 7 & PartidoPoliticoSigla == "FA"), aes(label=NombreLider), size=3, nudge_x = 1.2, nudge_y = .3) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 4.3 & TotalAños < 7 & PartidoPoliticoSigla == "FA"), aes(label=NombreLider), segment.alpha = 0, size=3, nudge_x = 1.3, nudge_y = .1) +
geom_text_repel(data=subset(datosAgrupadosAbsoluto, TotalAños > 4.1 & TotalAños < 4.3 & Sexo== "F" & PartidoPoliticoSigla == "FA"), aes(label=NombreLider), segment.alpha = 0, size=3, nudge_x = 1.2, nudge_y = -.2) +
scale_fill_manual("", values = c("F"="turquoise4", "M"="coral3"), label=c("Mujer", "Hombre")) +
labs(x="Total de años en puestos de poder dentro del partido",
title="Distribución de líderes partidarios, según sexo y tiempo de permanencia en la cúpula. 1982-2017") +
theme_bw() +
theme(panel.grid.minor = element_blank(), panel.grid.major.y = element_blank() ,axis.title.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank()) +
theme(axis.title.x = element_text(size = 14),axis.text.x = element_text(size = 13)) +
theme(strip.text.y = element_text(angle = 180, size = 13, face = "bold")) +
theme(legend.text = element_text(size = 13), legend.position = "bottom") +
guides(fill=guide_legend(reverse=TRUE))
Dispersión (scatterplot) geom_point()
Los gráficos de dispersión son gráficos de puntos con dos variables continuas. Se pueden combinar con variables cualitativos en el color u otras cuantitavas en el tamaño de los puntos combinando características vistas en gráficos anteriores.
Scatterplot con color y tamaño (en un mismo atributo):
Este incluye la graficación de cuatro atributos: Dos en los ejes (X y Y), el tamaño y el color se usan para representar una razón, y las etiquetas para distintguir los países.
library(ggplot2)
library(ggrepel)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
datos <- read.csv("ComisionesLegislativas.csv", sep = ";", dec = ",")
# ver tabla
head(datos)## País Comisiones Diputados Razon
## 1 Brasil 20 513 25.7
## 2 Colombia 7 166 23.7
## 3 México 39 500 12.8
## 4 Ecuador 12 137 11.4
## 5 Venezuela 15 163 10.9
## 6 Bolivia 12 130 10.8#Grafico
ggplot(datos, aes(Comisiones, Diputados)) +
geom_text_repel(aes(label=País), box.padding = unit(0.5, "lines"), point.padding = unit(0.6, "lines"), segment.size = .2) +
geom_point(aes(size=Razon, color=Razon)) +
scale_size_area(max_size = 15) +
scale_color_gradientn("Razón de\nrepresentación\nlegislativa\n", colors = c("deepskyblue", "deepskyblue4", "gray50", "indianred3")) +
labs(x="Cantidad de comisiones", y="Tamaño del Congreso (cantidad de legisladores)",
title="Relación entre la cantidad de comisiones y el tamaño del Congreso\n en América Latina, según razón de representación legislativa") +
scale_x_continuous(breaks = seq(0,50,10), limits = c(1,50), expand = c(0,0)) +
scale_y_continuous(breaks = seq(0,550,100), limits = c(1,550), expand = c(0,0)) +
theme_bw() +
theme(panel.grid.minor = element_blank()) +
theme(axis.title = element_text(size = 14), axis.text = element_text(size = 13)) +
theme(legend.text = element_text(size = 12), legend.title = element_text(size = 13)) +
guides(color= guide_colorbar(barwidth = 1.5, barheight = 8, title.vjust = .7)) +
guides(size=FALSE)
Scatterplot con color y tamaño (cinco atributos):
Este incluye la graficación de cinco atributos: Dos en los ejes (X y Y), el tamaño para representar el PIB, el color para identificar el tipo de sector, y las etiquetas para distinguir la actividad económica en específico. Dado que hay superposición de datos, se usa transparencia sobre los puntos para ver con mayor claridad todos los casos alpha=.8.
Vale anotar que las etiquetas se ponen de manera selectiva, es decir, se definen de previo. Para eso se crea un vector, llamado pointsToLabel en el código, con las actividades económicas que interesan mostrar en el gráfico.
library(ggplot2)
library(dplyr)
library(ggrepel) # editar etiquetas de Cantón
setwd("~/Dropbox/PEN/BigData/Encadenamientos_Karla")
datos <- read.csv("encadenamientos.csv", sep = ";", stringsAsFactors = F)
# Cambiar etiquetas
datos[datos == "Energía eléctrica, gas, vapor y aire acondicionado"] <- "Energía eléctrica"
datos[datos == "Servicios de Comercio"] <- "Comercio"
datos[datos == "Servicios de alojamiento"] <- "Alojamiento"
datos[datos == "Servicio de suministro de comida y bebidas"] <- "Comidas y bebidas"
datos[datos == "Servicios de información, programación y consultoría informática, edición de programas informáticos y afines"] <- "Informática"
datos[datos == "Servicios de intermediación financiera medidos indirectamente (SIFMI)"] <- "Intermediación financiera"
datos[datos == "Servicios de investigación científica y desarrollo"] <- "Investigación"
datos[datos == "Otros servicios profesionales, científicos y técnicos"] <- "Serv. profesionales"
datos[datos == "Servicios de agencias de viajes, operadores turísticos, servicios de reservas y actividades conexas"] <- "Agencia viajes"
# Se definen los sectores a nombrar en etiquetas
pointsToLabel <- c("Energía eléctrica","Comercio","Alojamiento","Comidas y bebidas","Informática","Intermediación financiera","Investigación",
"Serv. profesionales","Agencia viajes")
# ver tabla
head(datos)## cod
## 1 NP035
## 2 NP115
## 3 NP125
## 4 NP126
## 5 NP131
## 6 NP137
## nomb
## 1 Servicios de apoyo a la agricultura, la ganadería y actividades postcosecha
## 2 Servicios de reparación e instalación de maquinaria y equipo
## 3 Servicios especiales y generales de la construcción
## 4 Comercio
## 5 Transporte de carga
## 6 Otros servicios de apoyo al transporte
## regimen PD SD PIB Tipo.sector
## 1 Régimen Definitivo 1.048518 3.268399 80684.40 clave
## 2 Régimen Definitivo 1.003909 1.735139 86156.39 clave
## 3 Régimen Definitivo 1.048736 2.230604 298790.22 clave
## 4 Régimen Definitivo 1.004100 7.184651 2036472.89 clave
## 5 Régimen Definitivo 1.001925 3.699738 242268.25 clave
## 6 Régimen Definitivo 1.230103 1.561341 67014.22 clave# PLOT
ggplot(datos, aes(PD, SD)) +
geom_hline(yintercept = 1) +
geom_vline(xintercept = 1) +
geom_point(aes(size=PIB, fill=Tipo.sector), color="black", pch=21, alpha=.8) +
geom_text_repel(aes(label = nomb), size=3,
color = "gray20", segment.color = "black",
segment.size = 0.3,
data = subset(datos, nomb %in% pointsToLabel),
force = 11) +
scale_fill_manual("Tipo de sector:", values = c("clave"="coral", "estratégico"="forestgreen", "impulsor"="steelblue1", "ind"="gold2")) +
scale_y_continuous(breaks = seq(-2,10,1), limits = c(-2,10), expand = c(0,0)) +
scale_size_area(max_size = 20) +
labs(x="\nPoder de dispersión", y="Sensibilidad de dispersión") +
theme_minimal() +
theme(panel.grid = element_blank()) +
theme(axis.title = element_text(size = 14), axis.text = element_text(size = 13)) +
guides(fill = guide_legend(override.aes = list(size=8)))
Rectángulos geom_tile() y geom_rect()
Los gráficos de rectángulos son muy útiles para hacer mapas de calor (heatmaps), y en combinación con otras capas en el ggplot permite flexibilidada para visualizaciones más complejas como se verá en algunos ejemplos de seguido.
Mapa de calor (heat map):
Ilustra de manera fácil la intensidad de una variable en específico. Al combinarlo con variables en el eje X y Y es posible resumir información en un sólo panel en forma de matriz.
## HEAT-MAP PROPUESTAS PARTIDARIAS
library(openxlsx)
library(ggplot2)
library (plotly)
library(gridExtra)
setwd("~/Dropbox/PEN/BigData/VotemosCR.com/VotemosCR_17_18/ProgGobierno/Post1_propuestas2014")
datos <- read.xlsx(xlsxFile = "OfertaProgramatica(v31-8-2016).xlsx", sheet = 1, startRow = 1,skipEmptyRows = FALSE, rowNames=T)
datos2 <- as.matrix(datos)
# Totales por tema
Totales <- transform(datos, sum=rowSums(datos))
## GRAFICO EN GGPLOT
# Data wrangling
datos3 <- read.xlsx(xlsxFile = "OfertaProgramatica(v31-8-2016).xlsx", sheet = 1, startRow = 1,skipEmptyRows = FALSE, rowNames=F)
datos3 <- gather(datos3, key = Partido, value = Propuestas, 2:8)
#Orden a factores
datos3$Tema <- gsub("Productividad \r\ny empleo", "Productividad y empleo", datos3$Tema)
datos3$Tema <- factor(datos3$Tema, levels = c("Solvencia del Estado", "Medio ambiente", "Gestión política", "Productividad y empleo", "Pobreza y desigualdad"),
labels = c("Solvencia\ndel Estado", "Medio\nambiente", "Gestión\npolítica", "Productividad\ny empleo", "Pobreza \ny desigualdad"))
datos3$Partido <- factor(datos3$Partido, levels = c("FA","ML","PUSC","PLN","PAC","PASE","RC"))
# ver tabla
head(datos3)## Tema Partido Propuestas
## 1 Solvencia\ndel Estado FA 333
## 2 Medio\nambiente FA 567
## 3 Gestión\npolítica FA 649
## 4 Productividad\ny empleo FA 673
## 5 Pobreza \ny desigualdad FA 953
## 6 Solvencia\ndel Estado ML 332# Grafico
ggplot(datos3, aes(Partido, Tema, fill=Propuestas)) +
geom_tile() +
scale_fill_gradientn("Cantidad de\nreferencias", colors = c("white","steelblue", "darkblue"), breaks=c(0,200,400,600,800,1000)) +
labs(x="", y="",
title = "Cantidad de referencias a temas de desarrollo humano\nen programas de gobierno para la elección de 2014") +
theme_minimal() +
theme(axis.text = element_text(size = 14)) +
theme(legend.position = "bottom", legend.title = element_text(size=14), legend.text = element_text(size=13)) +
theme(legend.key.height = unit(2, "lines"), legend.key.width = unit(2.5, "lines"))
Mapa de calor INTERACTIVO (heat map):
Este ejemplo es el mismo caso pero interactivo usando el paquete plotly. Al posicionar el cursor sobre el gráfico es posible tener información adicional para cada punto de datos (eje Z). El paquete plotly usa como base un gráfico de ggplot, no obstante, en algunos casos requiere código adicional para darle el formato deseado. Es común que se requieran ajustes manuales en las etiquetas de los datos para la función interactiva (tooltip), o las de los ejes X y Y, entre otros.
library(openxlsx)
library(ggplot2)
library (plotly)
library(gridExtra)
setwd("~/Dropbox/PEN/BigData/VotemosCR.com/VotemosCR_17_18/ProgGobierno/Post1_propuestas2014")
datos <- read.xlsx(xlsxFile = "OfertaProgramatica(v31-8-2016).xlsx", sheet = 1, startRow = 1,skipEmptyRows = FALSE, rowNames=T)
# ver tabla
head(datos)## FA ML PUSC PLN PAC PASE RC
## Solvencia del Estado 333 332 162 125 152 144 30
## Medio ambiente 567 295 403 311 225 180 37
## Gestión política 649 472 478 394 285 266 74
## Productividad \r\ny empleo 673 807 671 505 343 318 67
## Pobreza y desigualdad 953 806 874 530 407 565 90datos2 <- as.matrix(datos)
# Totales por tema
Totales <- transform(datos, sum=rowSums(datos))
# Heatmap con plotly (datos en matriz)
# Custom colorscale
vals <- unique(scales::rescale(c(volcano)))
o <- order(vals, decreasing = FALSE)
cols <- scales::col_numeric("Blues", domain = NULL)(vals)
colz <- setNames(data.frame(vals[o], cols[o]), NULL)
#gráfico
Cantidad <- datos2
plot_ly(z = Cantidad,
x = c("FA","ML","PUSC","PLN","PAC","PASE","RC"), y = c("Solvencia del\nEstado","Medio\nambiente","Gestión\npolítica", "Productividad\ny empleo", "Pobreza\ny desigualdad"),
type = "heatmap", colorscale = colz) %>%
layout(titlefont = list(size = 14),
title = "Cantidad de referencias a temas de desarrollo humano\nen programas de gobierno para la elección de 2014",
margin= list(l = 100,r = 40,b = 80,t = 80)) %>%
layout(legend = list(orientation = 'h', xanchor = "center", x = 3, y = -2))Gráfico tipo panel:
Una variación de los gráficos rectangulares es la posibilidad de rellenar cada figura de colores distintos y poner color sobre el contorno de la figura geométrica para distinguir la información. Por ejemplo, un gráfico de panel permite transformar los rectángulos en líneas y dar seguimiento a los cambios en el comportamiento de una misma observación a lo largo del tiempo. Tal es el caso del gráfico para el panel electoral del 2014. Nótese, en el código, la transformación de los datos (por ejemplo el gather()) para acomodar la información a las especificaciones de la gramática de gráficos de ggplot. Cada línea representa una persona, el color muestra la intención de voto, y sobre el eje X se representa el tiempo en el que se aplicó cada una de las rondas del panel. Es posible concluir una amplia volatilidad electoral dado que gran parte de la población cambió su intención de voto. Al final, la mayoría de cambios fueron hacia el amarillo (Partido Acción Ciudadana).
library(ggplot2)
library(dplyr)
library(tidyr)
library(forcats)
library(plotly)
# Datos
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("Panel2014.csv", sep = ";", stringsAsFactors = F)
# Eliminar los blancos
datos[datos==""]<-NA # tiene que ser character (no sirve con factores)
datos <- na.omit(datos)
# Se da valor a id consecutivo
datos$ID <- seq.int(nrow(datos))
datos[datos=="Indeciso"] <- 0
datos[datos=="PLN"] <- 1
datos[datos=="FA"] <- 2
datos[datos=="PAC"] <- 3
datos[datos=="PUSC"] <- 4
datos[datos=="ML"] <- 5
datos[datos=="Otro"] <- 6
datos$Octubre <- as.numeric(datos$Octubre)
datos$Noviembre <- as.numeric(datos$Noviembre)
datos$Diciembre <- as.numeric(datos$Diciembre)
datos$Enero <- as.numeric(datos$Enero)
datos$Febrero <- as.numeric(datos$Febrero)
datos <- datos[,-1]
datos <- datos %>% arrange(Octubre, Noviembre, Diciembre, Enero, Febrero)
datos$individuo <- seq.int(nrow(datos))
# Se cambia formato del DF
datos2 <- gather(datos, Mes, Partido, 1:5)
datos2$Partido <- as.character(datos2$Partido)
# Orden a factores
datos2$Mes <- factor(datos2$Mes, levels = c("Octubre", "Noviembre", "Diciembre", "Enero", "Febrero"))
# ver tabla
head(datos2)## ID individuo Mes Partido
## 1 26 1 Octubre 0
## 2 38 2 Octubre 0
## 3 82 3 Octubre 0
## 4 93 4 Octubre 0
## 5 101 5 Octubre 0
## 6 75 6 Octubre 0# Gráfico
ggplot(datos2, aes(x=Mes, y=individuo, fill=Partido)) +
geom_tile() +
geom_hline(yintercept = .5:121.5, size=.08, color='grey80') +
scale_x_discrete(expand = c(0,0)) +
scale_fill_manual("Partido", values = c("grey50", "forestgreen", "grey10", "gold2", "steelblue", "red", "purple"), labels=c("Indecisos", "PLN", "FA", "PAC", "PUSC", "ML", "Otro")) +
theme_minimal() +
labs(title="Panel electoral: trayectorias individuales de las preferencias electorales",
sutitle="primera ronda, elecciones 2014") +
theme(panel.grid = element_blank())
Gráfico tipo escalera:
Considerando la gramática de gráficos y las distintas capas que es posible incluir en ggplot, se pueden realizar visualizaciones ajustadas a otras necesidades. Tal es el caso de este gráfico tipo escalera que registra, para cada administración y legislatura, la proporción de legislación heredada, es decir, que fue propuesta por el Congreso y el Ejecutivo de administraciones anteriores versus la de cosecha propia (administración en ejercicio).
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggjoy)
library(tidyquant)
library(plotly)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
#datos <- read.csv("BBDDLeyes1990-2017_v11-6-17_SGC.csv", sep = ";", stringsAsFactors=FALSE, header = T)
datos <- read.csv("BBDDLeyes1990-2017_v20-7-17.csv", sep = ";", stringsAsFactors=FALSE, header = T)
# Pasar a factor varias columnas
cols <- c("TipoLegislacion", "TipoLegislacion_2", "Derechos", "Obligaciones", "RequiereRecursos", "ContenidoFinanciero")
datos <- datos %>% mutate_each_(funs(factor(.)),cols)
#Dar formato de fechas a columnas
datos$FechaAprobacion <- as.Date(datos$FechaAprobacion, "%m/%d/%Y")
datos$Sancion <- as.Date(datos$Sancion, "%m/%d/%Y")
datos$FechaInicio <- as.Date(datos$FechaInicio, "%m/%d/%Y")
# Calcular dias de aprobacion
datos$DuracionDias2 <- datos$FechaAprobacion - datos$FechaInicio #nueva fecha de duracion dias
datos$ControlDias <- datos$DuracionDias - datos$DuracionDias2 #control de que Duracion en dias del Excel coincide con el hecho en R
# Columna de Duracion en Años
datos$DuracionAño <- datos$DuracionDias2/365
## NOTA para "BBDDLeyes1990-2017_v11-6-17_SGC.csv": DuracionDias original del Excel tiene missings. Ver fila 2296 del dataframe en el original enviado por Mario Herrera. Ya coregido en version Excel SGC
# Se corta nombre de Legislatura con REGEX y se da formato a factores en orden para gráficos
datos$Legislatura2 <- gsub("*\\-[0-9]{2}", "/", datos$Legislatura)
datos$Legislatura2 <- gsub("^[0-9]{2}", "", datos$Legislatura2)
# Factor en orden
datos$Legislatura2 <- factor(datos$Legislatura2, levels = unique(datos$Legislatura2))
# Se crea columna de Administracion Aprobacion
datos$AdmAprobacion <- ifelse(datos$FechaAprobacion < "1994-05-1", "Calderón",
ifelse(datos$FechaAprobacion < "1998-05-1", "Figueres",
ifelse(datos$FechaAprobacion < "2002-05-1", "Rodríguez",
ifelse(datos$FechaAprobacion < "2006-05-1", "Pacheco",
ifelse(datos$FechaAprobacion < "2010-05-01", "Arias(2)",
ifelse(datos$FechaAprobacion < "2014-05-1", "Chinchilla",
ifelse(datos$FechaAprobacion < "2018-05-1", "Solís", 0)))))))
# Se crea una columna para identificar cuando una ley es aprobada dentro del periodo de mandato del gobierno de turno
datos$LegPropia <- ifelse(datos$AdministracionInicio == datos$AdmAprobacion, "propia", "otra")
#######################################################################
### Legislación de cosecha propia versus legislacion heredada
#######################################################################
datosLegPropia <- datos %>% group_by(AdmAprobacion, Legislatura, LegPropia) %>% summarise(total= n()) %>%
mutate(porcentaje= round(total/sum(total)*100))
# Corregir etiqueta de Arias para grafico
datosLegPropia$AdmAprobacion[datosLegPropia$AdmAprobacion == "Arias(2)"] <- "Arias"
#Orden de los factores
datosLegPropia$Legislatura2 <- gsub("*\\-[0-9]{2}", "-", datosLegPropia$Legislatura)
datosLegPropia$Legislatura2 <- gsub("^[0-9]{2}", "", datosLegPropia$Legislatura2)
datosLegPropia$Legislatura2 <- factor(datosLegPropia$Legislatura2, levels = c("1"="90-91", "2"="91-92", "3"="92-93", "4"="93-94", "5"="94-95",
"6"="95-96", "7"="96-97", "8"="97-98", "9"="98-99", "10"="99-00",
"11"="00-01", "12"="01-02","13"="02-03","14"="03-04", "15"="04-05",
"16"="05-06", "17"="06-07", "18"="07-08", "19"="08-09", "20"="09-10",
"21"="10-11", "22"="11-12", "23"="12-13", "24"="13-14", "25"="14-15",
"26"="15-16", "27"="16-17"))
datosLegPropia$AdmAprobacion <- factor(datosLegPropia$AdmAprobacion, levels = c("1"="Calderón", "2"="Figueres",
"3"="Rodríguez", "4"="Pacheco",
"5"="Arias", "6"="Chinchilla", "7"="Solís"))
datosLegPropia$AdmAprobacion <- factor(datosLegPropia$AdmAprobacion, levels = c("7"="Calderón", "6"="Figueres",
"5"="Rodríguez", "4"="Pacheco",
"3"="Arias", "2"="Chinchilla", "1"="Solís"))
#Variable discreta para porcentaje, para graficar
datosLegPropia$Mayoria <- ifelse(datosLegPropia$porcentaje >= 50, "Mayor a 50%","Menor a 50%")
datosLegPropia$Mayoria <- factor(datosLegPropia$Mayoria, levels = c("1"="Menor a 50%", "2"="Mayor a 50%"))
# Subset de solo la legislacion heredada para revisar indicador para cuadro del RESUMEN
datosLegPropiaResumen <- subset(datosLegPropia, datosLegPropia$LegPropia == "otra")
# Subset de solo la legislacion propia para graficar
datosLegPropiaPlot <- subset(datosLegPropia, datosLegPropia$LegPropia == "propia")
# ver tabla
head(datosLegPropiaPlot)## # A tibble: 6 x 7
## # Groups: AdmAprobacion, Legislatura [6]
## AdmAprobacion Legislatura LegPropia total porcentaje Legislatura2 Mayoria
## <fct> <chr> <chr> <int> <dbl> <fct> <fct>
## 1 Arias 2006-2007 propia 10 14 06-07 Menor a 50%
## 2 Arias 2007-2008 propia 31 63 07-08 Mayor a 50%
## 3 Arias 2008-2009 propia 62 71 08-09 Mayor a 50%
## 4 Arias 2009-2010 propia 103 91 09-10 Mayor a 50%
## 5 Calderón 1990-1991 propia 21 23 90-91 Menor a 50%
## 6 Calderón 1991-1992 propia 42 71 91-92 Mayor a 50%# Time-line con ggplot: VERSION DOS ETIQUETAS COORD_FLIP
ggplot(datosLegPropiaPlot, aes(x=Legislatura, y=AdmAprobacion)) +
geom_tile(aes(fill = Mayoria), color="black") +
scale_fill_discrete("") +
labs(x= "", y="",
title="Proporción de leyes que fueron iniciativa de la administración\nen ejercicio, por legislatura y administración") +
coord_flip() +
expand_limits(x = -1) +
geom_text(aes(label=Legislatura), size=4) +
annotate("text", label = "Calderón", x = -.3, y = .6, size = 6, hjust=-.1, colour = "black") +
annotate("text", label = "Figueres", x = 3.6, y = 1.6, size = 6, hjust=-.1, colour = "black") +
annotate("text", label = "Rodríguez", x = 7.6, y = 2.6, size = 6, hjust=-.1, colour = "black") +
annotate("text", label = "Pacheco", x = 11.6, y = 3.6, size = 6, hjust=-.1, colour = "black") +
annotate("text", label = "Arias", x = 15.6, y = 4.7, size = 6, hjust=-.1, colour = "black") +
annotate("text", label = "Chinchilla", x = 19.6, y = 5.6, size = 6, hjust=-.1, colour = "black") +
annotate("text", label = "Solís", x = 23.6, y = 6.8, size = 6, hjust=-.1, colour = "black") +
theme_classic() +
theme(legend.position = "bottom", legend.text = element_text(size = 16)) +
theme(axis.text = element_text(size = 13)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5)) +
theme(axis.text.x = element_blank(), axis.ticks.x = element_blank()) +
theme(axis.text.y = element_blank(), axis.line.y = element_blank(), axis.ticks.y = element_blank()) +
guides(fill = guide_legend(nrow=2, reverse=TRUE)) +
theme(legend.key.size = unit(1.5, 'lines')) +
theme(legend.key = element_rect(color = 'white', size=1)) +
theme(legend.position = c(0.85, 0.3))
Gráfico de escalera y heat-map combinado:
El geométrico geom_tile es muy flexible, lo cual permite diferentes adecuaciones para representar los datos. Todo lo que requiere es un poco de creatividad para imaginar la posición y el orden del geométrico. Tal es el caso de este ejemplo que visualiza con estilo de heat-map la cantidad de diputados obtenido por cada partido representado en la Asamblea Legislativa desde 1953, y se ordenan de acuerdo al año de aparición, lo cual produce un gráfico de escalera.
En este caso también se requirió modificar la estructura inicial del dataframe para adecuarlo a la visualización. Para ello se utiliza la función gather() del paquete tidyr muy común para tranformaciones y data-wrangling con el fin de dar formato tidy a los datos.
library(tidyr)
library(dplyr)
library(ggplot2)
#Se cargan los datos
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("EscanosLegislativosHistorico.csv", sep = ";", stringsAsFactors = F, check.names = FALSE)
# Los datos originales tienen esta estructura
head(datos)## Partido 1953 1958 1962 1966 1970 1974 1978 1982
## 1 PLN 30 20 29 29 32 27 25 33
## 2 Demócrata 11 0 0 0 0 1 0 0
## 3 Unión Nacional 1 10 9 0 0 0 0 0
## 4 Republicano Nacional Independiente 3 0 0 0 0 0 0 0
## 5 Republicano 0 11 18 0 0 0 0 0
## 6 Union Civica Revolucionaria 0 1 0 2 0 0 0 0
## 1986 1990 1994 1998 2002 2006 2010 2014
## 1 29 25 28 23 17 25 24 18
## 2 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 1 0 0
## 4 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0# Se hacen transformaciones
Diputados <- datos
Diputados[Diputados == 0] <- NA
Diputados2 <- Diputados[,c(2:17)]/57
Diputados2$partido <- Diputados$Partido
Diputados2 <- Diputados2 %>% select(partido, everything())
# Se modifica DF
datos2 <- gather(datos, key=eleccion, value=diputados, -Partido)
# Reemplazar ceros por NA
datos2[datos2 == 0] <- NA
# Eliminar los NA
datos3 <- na.omit(datos2)
# Se cambia PLN por Liberación Nacional en las etiquetas
datos3$Partido <- gsub("PLN", "Liberación Nacional", datos3$Partido)
datos3$Partido <- gsub("Union Civica Revolucionaria", "Unión Cívica Revolucionaria", datos3$Partido)
#Orde de levels a partido de acuerdo con fecha
datos3$Partido <- factor(datos3$Partido, levels = c(as.character(unique(datos3$Partido))))
# el DataFrame (DF) final para graficación tiene esta nueva estructura
head(datos3)## Partido eleccion diputados
## 1 Liberación Nacional 1953 30
## 2 Demócrata 1953 11
## 3 Unión Nacional 1953 1
## 4 Republicano Nacional Independiente 1953 3
## 34 Liberación Nacional 1958 20
## 36 Unión Nacional 1958 10#Se hace el grafico
ggplot(datos3, aes(as.factor(eleccion), Partido)) +
geom_tile(aes(fill=diputados), color="white") +
theme_minimal() +
scale_fill_gradientn("Cantidad de legisladores ", colors = c("deepskyblue", "deepskyblue4", "gray50", "thistle4", "indianred3"), breaks=c(1,5,10,15,20,25,30)) +
theme(panel.grid.major.x = element_blank()) +
labs(x="\nAño de la elección", y="",
title="Poder electoral de los partidos políticos, según cantidad de legisladores. 1953-2014",
subtitle="(en orden de antigüedad)") +
theme(axis.title.x = element_text(size = 13), axis.text.x = element_text(size = 13)) +
theme(axis.title.y = element_text(size = 13), axis.text.y = element_text(size = 12)) +
theme(legend.position = "bottom", legend.title = element_text(size = 13), legend.text = element_text(size = 13)) +
guides(fill= guide_colorbar(barwidth = 14, barheight = 1.7, title.vjust = .7))
Boxplots geom_boxplot()
El gráfico de cajas o boxplot muestra de forma sencilla la distribución de una variable continua. En una sólo viualización es posible obtener seis estadísticos centrales: la mediana (segundo cuartil), el valor mínimo, el valor máximo, el primer cuartil (percentil 25), el tercer cuartil (percentil 75), y los valores atípicos (puntos fuera de los “bigotes” del gráfico).
library(ggplot2)
library(ggjoy)
library(dplyr)
library(tidyr)
library(plotly)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("BBDD_ConvocatExtraord_I-IIIAño_v27-07-17.csv", sep = ";", stringsAsFactors = F)
# Definir los niveles de factor
datos$Administración <- replace(datos$Administración, datos$Administración == "Figueres Olsen ", "Figueres Olsen")
# Variable multipartidismo
datos$sistpartidos <- ifelse(datos$Administración == "Calderón Fournier", "Bipartidismo",
ifelse(datos$Administración == "Figueres Olsen", "Bipartidismo",
ifelse(datos$Administración == "Rodríguez Echeverría", "Bipartidismo", "Multipartidismo")))
# ver tabla
head(datos)## ID No..Expediente
## 1 1 11181
## 2 2 10865
## 3 3 10699
## 4 4 11249
## 5 5 10353
## 6 6 10390
## Nombre.proyecto.de.ley
## 1 Expediente 11181 Reforma al articulo número 59 de la Ley N° 7097 del 18 de agosto de 1988
## 2 Expediente 10865 Estatuto de Servicio Policial Antidrogas
## 3 Expediente 10699 Reforma a los artículos 195 y 289 del Código de Procedimientos Penales y al artículo 27 de la Ley Orgánica del Organismo de Investigación Judicial y al artículo 100 de la Ley orgánica del Banco Central de Costa Rica
## 4 Expediente 11249 Ley de Creación del consejo Técnico de Aeropuertos
## 5 Expediente 10353 Derogatoria del artículo 154 de la Ley General de Migración y Extranjería
## 6 Expediente 10390 Reforma al artículo 113 de la Constitución Política
## Adm_año Administración Año.de.Administración
## 1 1990-1991(Calderón) Calderón Fournier Primer año
## 2 1990-1991(Calderón) Calderón Fournier Primer año
## 3 1990-1991(Calderón) Calderón Fournier Primer año
## 4 1990-1991(Calderón) Calderón Fournier Primer año
## 5 1990-1991(Calderón) Calderón Fournier Primer año
## 6 1990-1991(Calderón) Calderón Fournier Primer año
## Convocatoria_Per1..p.DiasLab. X1era.Convocatoria X1era.Desconvocatoria
## 1 12/30/1899 0 0
## 2 12/30/1899 0 0
## 3 12/30/1899 0 0
## 4 12/30/1899 0 0
## 5 12/30/1899 0 0
## 6 12/30/1899 0 0
## X2nda.Convocatoria X2nda.Desconvocatoria X3era.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X3era.Desconvocatoria X4ta.Convocatoria X4ta.Desconvocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## Desconvocatoria_Per1..p.DiasLab. DiasLab_1perid Convocatoria_Per2..p.DiasLab.
## 1 8/31/1990 0 3/26/1991
## 2 8/31/1990 0 3/20/1991
## 3 8/31/1990 0 3/20/1991
## 4 8/31/1990 0 3/20/1991
## 5 8/31/1990 0 3/20/1991
## 6 8/31/1990 0 3/20/1991
## X1era.Convocatoria.1 X1era.Desconvocatoria.1 X2nda.Convocatoria.1
## 1 3/26/1991 0 0
## 2 3/20/1991 0 0
## 3 3/20/1991 0 0
## 4 3/20/1991 0 0
## 5 3/20/1991 0 0
## 6 3/20/1991 0 0
## X2nda.Desconvocatoria.1 X3era.Convocatoria.1 X3era.Desconvocatoria.1
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X4ta.Convocatoria.1 X4ta.Desconvocatoria.1 X5ta.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X5ta.Desconvocatoria X6ta.Convocatoria X6ta.Desconvocatoria X7ma.Convocatoria
## 1 0 0 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 0 0 0
## 6 0 0 0 0
## X7ma.Desconvocatoria X8va.Convocatoria X8va.Desconvocatoria X9na.Convocatoria
## 1 0 0 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 0 0 0
## 6 0 0 0 0
## X9na.Desconvocatoria X10ma.Convocatoria X10ma.Desconvocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X11ma.Convocatoria X11ma.Desconvocatoria X12da.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X12da.Desconvocatoria X13ra.Convocatoria X13ra.Desconvocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X14ta.Convocatoria X14ta.Desonvocatoria X15ta.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X15ta.Desconvocatoria X16ta.Convocatoria X16ta.Desconvocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X17ma.Convocatoria X17ma.Desconvocatoria X18va.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X18va.Desconvocatoria X19na.Convocatoria X19na.Desconvocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X20ma.Convocatoria X20ma.Desconvocatoria X21ra.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X21ra.Desconvocatoria X22da.Convocatoria X22da.Desconvocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X23ra.Convocatoria X23ra.Desconvocatoria X24ta.Convocatoria
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0
## X24ta.Desconvocatoria X25ta.Convocatoria Desconvocatoria_Per2..p.DiasLab.
## 1 0 0 4/30/1991
## 2 0 0 4/30/1991
## 3 0 0 4/30/1991
## 4 0 0 4/30/1991
## 5 0 0 4/30/1991
## 6 0 0 4/30/1991
## DiasLab_2perid DíaslabTOTAL FechaIntroProyecto Administracion.de.Inicio
## 1 35 35 3/6/1991 Calderon Fournier
## 2 41 41 11/28/1989 Arias Sánchez 1
## 3 41 41 8/25/1988 Arias Sánchez 1
## 4 41 41 2/25/1991 Calderon Fournier
## 5 41 41 9/2/1986 Arias Sánchez 1
## 6 41 41 11/28/1986 Arias Sánchez 1
## Iniciativa PartidoProponente Tema
## 1 Ejecutivo Ejecutivo Presupuesto estatal
## 2 Legislativa Ejecutivo Seguridad
## 3 Ejecutivo Ejecutivo Sistema Judicial
## 4 Legislativa Ejecutivo Transporte
## 5 Legislativa Ejecutivo Migración
## 6 Legislativa Ejecutivo Reformas Constitucionales
## Fecha.de.aprobación.del.proyecto X.Aprobado.en.algún.momento.
## 1 Archivado 0
## 2 Archivado 0
## 3 Archivado 0
## 4 Archivado 0
## 5 Archivado 0
## 6 Archivado 0
## Legislatura.en.que.fue.aprobada Proyecto.aprobado.en.primer.año
## 1 <NA> 0
## 2 <NA> 0
## 3 <NA> 0
## 4 <NA> 0
## 5 <NA> 0
## 6 <NA> 0
## Proyecto.aprobado.en.segundo.año Proyecto.aprobado.en.tercer.año
## 1 0 0
## 2 0 0
## 3 0 0
## 4 0 0
## 5 0 0
## 6 0 0
## Proyecto.Aprobado.en.sesiones.extraordinarias
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0
## Subtotal.Convocatorias.Primer.Período Subtotal.Convocatorias.Segundo.Periodo
## 1 0 1
## 2 0 1
## 3 0 1
## 4 0 1
## 5 0 1
## 6 0 1
## TotalConvocatorias sistpartidos
## 1 1 Bipartidismo
## 2 1 Bipartidismo
## 3 1 Bipartidismo
## 4 1 Bipartidismo
## 5 1 Bipartidismo
## 6 1 Bipartidismo# boxplot
ggplot(data = datos, aes(x=Adm_año, y=TotalConvocatorias)) +
xlab("\nAño de administración") + ylab("Cantidad de convocatorias") +
ggtitle("Distribución de la cantidad de convocatorias de proyectos de ley en sesiones extraordinarias, por año y administración") +
geom_boxplot(aes(fill=sistpartidos, color=sistpartidos), color="black") +
scale_color_manual("", values = c("Bipartidismo"="grey50", "Multipartidismo"="steelblue")) +
scale_fill_manual("", values = c("Bipartidismo"="grey50", "Multipartidismo"="steelblue")) +
scale_y_continuous(breaks=seq(0, 26, 2), limits=c(0, 26), expand = c(0, 0)) +
theme(axis.text.x = element_text(size = rel(1.3), angle=90, hjust = 1)) +
theme(axis.text.y = element_text(size = 14)) +
theme(panel.grid.major.y = element_line(colour = "grey95")) +
theme(legend.key = element_rect(fill = "white")) +
theme(panel.background = element_rect(fill = "white")) +
theme(axis.line.x = element_line(colour = "black")) +
theme(axis.line.y = element_line(colour = "black"))
Histograma geom_histogram()
El histograma es muy utilizado en las etapas de exploración de los datos, sobre todo para conocer la distribución de los mismos. Es posible agrupar los datos en ‘bins’ o secciones que se representan con el grosor de las barras en el gráfico. Las barras más altas denotan la concentración de los datos, en la posición que marca el intervalo sobre el eje X. Acá se muestra un ejemplo sobre la cantidad de años que toma aprobar las leyes en Costa Rica.
## BBDD desempeño legislativo
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggjoy)
library(tidyquant)
library(plotly)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
datos <- read.csv("BBDDLeyes1990-2017_v20-7-17.csv", sep = ";", stringsAsFactors=FALSE, header = T)
# Pasar a factor varias columnas
cols <- c("TipoLegislacion", "TipoLegislacion_2", "Derechos", "Obligaciones", "RequiereRecursos", "ContenidoFinanciero")
datos <- datos %>% mutate_each_(funs(factor(.)),cols)
#Dar formato de fechas a columnas
datos$FechaAprobacion <- as.Date(datos$FechaAprobacion, "%m/%d/%Y")
datos$Sancion <- as.Date(datos$Sancion, "%m/%d/%Y")
datos$FechaInicio <- as.Date(datos$FechaInicio, "%m/%d/%Y")
# Calcular dias de aprobacion
datos$DuracionDias2 <- datos$FechaAprobacion - datos$FechaInicio #nueva fecha de duracion dias
datos$ControlDias <- datos$DuracionDias - datos$DuracionDias2 #control de que Duracion en dias del Excel coincide con el hecho en R
# Columna de Duracion en Años
datos$DuracionAño <- datos$DuracionDias2/365
# Se corta nombre de Legislatura con REGEX y se da formato a factores en orden para gráficos
datos$Legislatura2 <- gsub("*\\-[0-9]{2}", "/", datos$Legislatura)
datos$Legislatura2 <- gsub("^[0-9]{2}", "", datos$Legislatura2)
# Factor en orden
datos$Legislatura2 <- factor(datos$Legislatura2, levels = unique(datos$Legislatura2))
# Se crea columna de Administracion Aprobacion
datos$AdmAprobacion <- ifelse(datos$FechaAprobacion < "1994-05-1", "Calderón",
ifelse(datos$FechaAprobacion < "1998-05-1", "Figueres",
ifelse(datos$FechaAprobacion < "2002-05-1", "Rodríguez",
ifelse(datos$FechaAprobacion < "2006-05-1", "Pacheco",
ifelse(datos$FechaAprobacion < "2010-05-01", "Arias(2)",
ifelse(datos$FechaAprobacion < "2014-05-1", "Chinchilla",
ifelse(datos$FechaAprobacion < "2018-05-1", "Solís", 0)))))))
# Se crea una columna para identificar cuando una ley es aprobada dentro del periodo de mandato del gobierno de turno
datos$LegPropia <- ifelse(datos$AdministracionInicio == datos$AdmAprobacion, "propia", "otra")
# ver tabla
head(datos)## Ley Expediente
## 1 7148 9481
## 2 7149 10163
## 3 7150 10450
## 4 7151 10531
## 5 7152 10468
## 6 7153 10632
## NombreLey
## 1 VETO N°. 7148 DE 3 DE JULIO DE 1990. MODIFICACION AL ARTICULO 23 DE LA LEY CONSTITUTIVA DE LA CAJA COSTARRICENSE DE SEGURO SOCIAL, A EFECTO DE QUE LAS CUOTAS OBLIGATORIAS A CARGO DE PATRONOS Y TRABAJADORES SOLO PUEDAN VARIARSE POR LEY.
## 2 LEY DE CREACION DEL REFUGIO NACIONAL DE VIDA SILVESTRE DE TAMARINDO
## 3 LEY DE PRORROGA Y AMPLIACION DE LA CONCESION ELECTRICA A FAVOR DE LA FINCA "LA ARGENTINA", S.A.
## 4 LEY DE AUTORIZACIÓN AL INSTITUTO MIXTO DE AYUDA SOCIAL PARA TRASPASAR TERRENOS DE SU PROPIEDAD
## 5 CONVERSION DEL MINISTERIO DE INDUSTRIA, ENERGIA Y MINAS EN MINISTERIO DE RECURSOS NATURALES, ENERGIA Y MINAS.
## 6 LEY DE FOMENTO DE LA PRODUCCION DE CABUYA
## OrganoAprobacion IniciativaNombre
## 1 Plenario TREJOS E, TREJOS F, UGALDE Á, RODRÍGUEZ S, GUZMÁN M.
## 2 Plenario BRENES GÓMEZ
## 3 Plenario PODER EJECUTIVO
## 4 Plenario BORBÓN ARIAS
## 5 Plenario CARVAJAL HERRERA
## 6 Plenario JIMÉNEZ P, DELGADO M
## IniciativaPoder fraccion_1 fraccion_2
## 1 Legislativo VARIOS DIPUTADOS Y DIPUTADAS VARIOS DIPUTADOS Y DIPUTADAS
## 2 Legislativo PUSC PUSC
## 3 Ejecutivo Ejecutivo Ejecutivo
## 4 Legislativo PUSC PUSC
## 5 Legislativo PLN PLN
## 6 Legislativo VARIOS DIPUTADOS Y DIPUTADAS VARIOS DIPUTADOS Y DIPUTADAS
## FechaAprobacion Mes Legislatura Periodo Publicacion Sancion
## 1 1990-05-16 Mayo 1990-1991 1-Ordinario 124 03/07/1990 <NA>
## 2 1990-05-16 Mayo 1990-1991 1-Ordinario 121 27/06/1990 1990-06-05
## 3 1990-05-16 Mayo 1990-1991 1-Ordinario 121 27/06/1990 1990-06-05
## 4 1990-05-04 Mayo 1990-1991 1-Ordinario 150 10/08/1990 1990-07-24
## 5 1990-05-17 Mayo 1990-1991 1-Ordinario 117 21/06/1990 1990-06-05
## 6 1990-05-17 Mayo 1990-1991 1-Ordinario 132 13/07/1990 1990-06-29
## FechaInicio AdministracionInicio DuracionDias TipoLegislacion
## 1 1982-11-17 Monge 2737 1
## 2 1985-07-30 Monge 1751 1
## 3 1987-05-12 Arias(1) 1100 7
## 4 1987-09-02 Arias(1) 975 7
## 5 1987-05-20 Arias(1) 1093 7
## 6 1988-05-02 Arias(1) 745 1
## TipoLegislacion_2 Derechos Obligaciones RequiereRecursos ContenidoFinanciero
## 1 <NA> 1 1 2 3
## 2 <NA> 1 1 1 3
## 3 <NA> 2 2 2 3
## 4 <NA> 1 1 1 2
## 5 <NA> 3 2 2 3
## 6 <NA> 2 1 1 3
## DuracionSancion Conteo DuracionDias2 ControlDias DuracionAño Legislatura2
## 1 #VALUE! 1 2737 days 0 days 7.498630 days 90/91
## 2 20 1 1751 days 0 days 4.797260 days 90/91
## 3 20 1 1100 days 0 days 3.013699 days 90/91
## 4 81 1 975 days 0 days 2.671233 days 90/91
## 5 19 1 1093 days 0 days 2.994521 days 90/91
## 6 43 1 745 days 0 days 2.041096 days 90/91
## AdmAprobacion LegPropia
## 1 Calderón otra
## 2 Calderón otra
## 3 Calderón otra
## 4 Calderón otra
## 5 Calderón otra
## 6 Calderón otra# GRAFICO distribucion en Años: todas las leyes
ggplot(datos, aes(DuracionAño)) +
geom_histogram(fill="steelblue", color="black", binwidth = 1) +
scale_x_continuous(breaks=seq(0, 18, 1), limits=c(0, 18), expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0), breaks = seq(0,800, 100), limits = c(0,800)) +
theme_classic() +
labs(x= "Duración en años", y="Cantidad de leyes",
title= "Distribución del tiempo que toma aprobar las leyes",
subtitle= "de mayo de 1990 a abril de 2017") +
theme(axis.text.x = element_text(size=11, face = "bold"), axis.title.x = element_text(size = 11, face = "bold"))
Densidad geom_density()
Permite ver la distribución de los datos sobre una variable continua o sobre un período de tiempo. Utiliza una función de densidad para suavizar los datos sobre el plot. Los puntos más altos en la gráfica muestran dónde se concentran los valores. Tiene una función similar al histograma. En este caso se presenta con facetas para ver la densidad comparada de seis casos distintos. Dado que las escalas en el eje ‘y’ son tan distintas para cada caso se dejan libre, tal y como se indica en el código facet_wrap(~Partido, scales="free_y").
library(ggplot2)
setwd("~/Dropbox/PEN/BigData/DesempeñoLegislativo/2017")
datos <- read.csv("BBDD_GraficoComisiones.csv", sep = ";")
# se hace un subset de los datos
datosPartidos <- subset(datos, Partido == "FA" | Partido == "FA" | Partido == "ML"|
Partido == "PAC" | Partido == "PASE" | Partido == "PLN" | Partido == "PUSC")
# ver tabla
head(datosPartidos)## Diputado PuestosComision Legislatura Periodo
## 1 Alberto Fait Lizano 1 1986-1987 1986-1990
## 2 Alex Solís Fallas 1 1986-1987 1986-1990
## 3 Alfonso Estevanovich González 1 1986-1987 1986-1990
## 4 Allen Ramón Arias Angulo 1 1986-1987 1986-1990
## 5 Ángel Marín Madrigal 2 1986-1987 1986-1990
## 6 Aníbal Enrique González Barrantes 1 1986-1987 1986-1990
## Partido
## 1 PLN
## 2 PLN
## 3 PLN
## 4 PLN
## 5 PLN
## 6 PLN# Grafico de Densidad
ggplot(datosPartidos, aes(x=PuestosComision, ..density.., fill= Partido)) +
geom_density(alpha=0.7, show.legend = F) +
facet_wrap(~Partido, scales="free_y") +
scale_fill_manual(name="", values = c("FA"="black","ML"="red", "PAC"="gold", "PASE"="lightblue", "PLN"="green", "PUSC"="blue")) +
theme_classic() +
scale_x_continuous(breaks=seq(0, 6, 1), limits=c(0, 6), expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
labs(x= "Cantidad de puestos en comisión",
y= "Densidad estimada de diputados",
title = "Distribución de puestos ocupados por los legisladores en comisiones ",
subtitle = "Período: 1986-2018")
Joyplots de densidad geom_joy()
El Gjoy es una variación específica que permite ver, en un sólo plano, la posición y la distribución de los datos utilizando facetas. Es un gráfico útil para exploración de datos de manera comparada. Se requiere la instalación de un paquete llamado ggjoy que se conecta con ggplot2 . El geométrico es llamado con el geom_joy(). En este ejemplo se incluyen etiquetas con el parámetro geom_text() para distinguir entre el período de bipartidismo y el de multipartidismo. También se marca en color azul los años en donde hubo casos extremos (más de seis convocatorias). El código incluye los pasos para transformar el dataframe y calcular todos los estadísticos necesarios para el gráfico.
library(ggplot2)
library(ggjoy)
library(dplyr)
library(tidyr)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("BBDD_ConvocatExtraord_I-IIIAño_v27-07-17.csv", sep = ";", stringsAsFactors = F)
# Definir los niveles de factor
datos$Administración <- replace(datos$Administración, datos$Administración == "Figueres Olsen ", "Figueres Olsen")
# Variable multipartidismo
datos$sistpartidos <- ifelse(datos$Administración == "Calderón Fournier", "Bipartidismo",
ifelse(datos$Administración == "Figueres Olsen", "Bipartidismo",
ifelse(datos$Administración == "Rodríguez Echeverría", "Bipartidismo", "Multipartidismo")))
# Funcion para detectar outliers
is_outlier <- function(x) {
return(x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x))
}
# Se define el promedio de convocatorias para cada año
datosPromedio <- datos %>% select(No..Expediente, Adm_año, TotalConvocatorias) %>% group_by(Adm_año) %>% mutate(promedio = mean(TotalConvocatorias))
# Se identifican los outliers (extremos) y se pone un cero a los valores validos (para luego usar en el ifelse seguido)
datosOutliers <- datosPromedio %>% group_by(Adm_año) %>% mutate(outlier = ifelse(is_outlier(TotalConvocatorias), TotalConvocatorias, as.numeric(0)))
# Para la administración 1992-1993, hay 43 proyectos con una convocatoria que aparece como "outlier" dada las colas del boxplot. Se ignora este valor y se mantiene el "1"
datosOutliers$outlierFinal <- ifelse(datosOutliers$outlier == 1, 0, datosOutliers$outlier)
# Se imputan los valores outliers (se toma la variable outlierFinal) con el promedio del año (el promedio se redondea a la unidad mas cercana)
datosImputados <- datosOutliers %>% mutate(ConvocatoriasImputado = ifelse(outlierFinal > 0, round(promedio), as.numeric(round(TotalConvocatorias))))
# Se marcan las legislaturas que tuvieron proyectos de ley que fueron convocados 7 o más veces (Se hace ifelse para detectarlas y luego se ponen manualmente)
datosImputados$Atipicos <- ifelse(datosImputados$TotalConvocatorias >= 7, "Hubo proyectos con más de seis convocatorias", "Normal")
datosImputados$Atipicos <- ifelse(datosImputados$Adm_año == "2007-2008(Arias)" |
datosImputados$Adm_año == "2012-2013(Chinchilla)" |
datosImputados$Adm_año == "2014-2015(Solís)" |
datosImputados$Adm_año == "2015-2016(Solís)" |
datosImputados$Adm_año == "2016-2017(Solís)",
"Hubo proyectos con más de seis convocatorias", "Normal")
# El dataframe final para graficación tiene la siguiente forma
head(datosImputados)## # A tibble: 6 x 8
## # Groups: Adm_año [1]
## No..Expediente Adm_año TotalConvocatori… promedio outlier outlierFinal
## <chr> <chr> <int> <dbl> <dbl> <dbl>
## 1 11181 1990-1991(Cald… 1 1.09 0 0
## 2 10865 1990-1991(Cald… 1 1.09 0 0
## 3 10699 1990-1991(Cald… 1 1.09 0 0
## 4 11249 1990-1991(Cald… 1 1.09 0 0
## 5 10353 1990-1991(Cald… 1 1.09 0 0
## 6 10390 1990-1991(Cald… 1 1.09 0 0
## # … with 2 more variables: ConvocatoriasImputado <dbl>, Atipicos <chr># Grafico Gjoy con DATOS IMPUTADOS - FINAL - geom_text
ggplot(datosImputados, aes(ConvocatoriasImputado, Adm_año)) +
geom_hline(yintercept=10, color = "black", linetype="dashed", size=.6) +
geom_joy(aes(fill=Atipicos), rel_min_height = 0.01, scale = 1) +
geom_text(aes(x=6.5, y=12.5, label="Multipartidismo")) +
geom_text(aes(x=6.5, y=7.5, label="Bipartidismo")) +
theme_minimal() + theme(axis.text.y = element_text(vjust = 0), panel.grid.minor = element_blank()) +
scale_fill_manual("", breaks=c("Hubo proyectos con más de seis convocatorias"), values = c("Normal"="grey", "Hubo proyectos con más de seis convocatorias"="steelblue")) +
scale_x_continuous(breaks = seq(0,7,1), limits = c(0,7)) +
scale_y_discrete(expand = c(0.01, 0)) +
labs(x="\nTotal de convocatorias",
y="Legislatura (administración)\n",
title="Distribución de la cantidad de convocatorias de proyectos de ley en sesiones extraordinarias",
subtitle= "(primeros tres años de gobierno y valores extremos imputados)") +
theme(legend.position = "bottom", legend.text = element_text(size = 14)) +
theme(axis.title = element_text(size = 14), axis.text = element_text(size = 13))
Flujograma Sankey
El Sankey es un tipo de flujograma que muestra la proporción de los datos de acuerdo con el grosor de cada flujo representado. Son útiles para ver los datos de mútiples categorías. En este caso no se usa ggplot, sino el paquete de visualización de google googleVis que genera un Sankey interactivo que permite ver los datos específicos al posicionar el cursor sobre el área de ploteo.
La galería de Google genera un HMTL por separado para cada gráfico, de manera que no sale incrustado en este documento. Se presenta una imagen en 2D del que genera la programación presentada. Se puede ver uno interactivo en el siguiente link: https://goo.gl/iLECGG
#################################################################
# Sankey Politica exterior: Comunicados de prensa
#################################################################
library(devtools)
require(googleVis)
setwd("~/Dropbox/PEN/BigData/Fortalecimiento/Inf_23")
datos <- read.csv("BBDDComunicados_v17-10-17.csv",sep = ";")
# ver tabla
head(datos)
### SANKEY PERSONALIZADO EN COLORES
#Array of colors
colors_link <- c('#C1CDCD', '#C1CDCD','#C1CDCD','#C1CDCD','#C1CDCD')
colors_link_array <- paste0("[", paste0("'", colors_link,"'", collapse = ','), "]")
colors_node <- c('darkblue')
colors_node_array <- paste0("[", paste0("'", colors_node,"'", collapse = ','), "]")
#SE GENERA EL SANKEY con Color de links y nodos por default (FINAL CAP)
plot(gvisSankey(datos, from="origen", to="destino", weight="valor",
options=list(height=600, width=650,
sankey=paste0("{link: { colorMode: 'target',
colors: ", colors_link_array ," },
node: { width: 10,
label: { fontName: 'Arial',
fontSize: 11,
bold: true,
italic: false } }}"))))
Gauge plot
El Gauge plot emula un panel de datos similar al de un velocímetro en un automóvil. Tiene como función identificar un rango de valores donde se ubican los datos. Generalmente incluye una línea o indicador para marcar en qué punto exacto se encuentra el valor que interesa resaltar. Son muy utilizados en dashboards para retratar múltiples indicadores.
Para hacerlos con ggplot es necesario correr la función gg.gauge() que genera la estructura del gauge, y luego se meten los datos combinando el paquete gridExtra con el ggplot.
##########################################################################
# Grafico Gauge
# Indicadores electorales y de cultura politica
##########################################################################
## multiple guages
library(gridExtra)
library(grid)
library(ggplot2)
# Función
gg.gauge <- function(pos,var,breaks=c(0,1,50,75,100)) {
require(ggplot2)
get.poly <- function(a,b,r1=0.5,r2=1.0) {
th.start <- pi*(1-a/100)
th.end <- pi*(1-b/100)
th <- seq(th.start,th.end,length=100)
x <- c(r1*cos(th),rev(r2*cos(th)))
y <- c(r1*sin(th),rev(r2*sin(th)))
return(data.frame(x,y))
}
ggplot()+
geom_polygon(data=get.poly(breaks[1],breaks[2]),aes(x,y),fill="red")+
geom_polygon(data=get.poly(breaks[2],breaks[3]),aes(x,y),fill="red")+
geom_polygon(data=get.poly(breaks[3],breaks[4]),aes(x,y),fill="gold")+
geom_polygon(data=get.poly(breaks[4],breaks[5]),aes(x,y),fill="forestgreen")+
geom_polygon(data=get.poly(pos-.2,pos+2,0.2),aes(x,y))+
annotate("text",x=0,y=0,label=pos,vjust=-1.5,size=5,fontface="bold")+
annotate("text",x=0,y=0,label=var,vjust=0,size=3,fontface="bold")+
coord_fixed()+
theme_bw()+
theme(axis.text=element_blank(),
axis.title=element_blank(),
axis.ticks=element_blank(),
panel.grid=element_blank(),
panel.border=element_blank())
}
## Indicadores de satisfaccion coyunturales - Lapop 2016
grid.newpage(recording = TRUE)
grid.draw(arrangeGrob(gg.gauge(22, "Evaluación situación económica"),gg.gauge(50, "Descontento ciudadano"),
gg.gauge(36, "Interés en la política"), gg.gauge(38, "Eficacia política"),
gg.gauge(45, "Confianza en el Congreso"), gg.gauge(33, "Confianza en partidos políticos"), ncol=2))
Waffle chart
El Waffle es un gráfico sencillo que permite ver la composición con base en cuadros que representan individuos o proporción de datos. Utiliza el paquete waffle de R. Es una forma sencilla de ver la proporción de la información sobre el 100%, aunque también se pueden usar con valores absolutos. En este caso se representa la composición del uso del tiempo en el aula en una clase de matemáticas.
##########################################################################
# Waffle chart: Perdida de Lecciones
##########################################################################
library(waffle)
## DATOS ABSOLUTOS
lecciones <- c(`Efectivas (111)`=111, `Tiempo perdido en clase (43)`=43, `Impuntualidad (13)`=13, `Actividades extracurriculares (56)`=56, `Exámenes y congresos (30)`=30)
## DATOS RELATIVOS
lecciones2 <- round(lecciones / 253 *100)
names(lecciones2) <- c("Efectivas (44%)", "Tiempo perdido en clase (17%)", "Impuntualidad (5%)", "Actividades extracurriculares (22%)", "Exámenes y congresos (12%)")
waffle(lecciones2, rows = 10, xlab="1 cuadro = 1%", size=1,
colors=c("#4682B4","#97b5cf","#a0d0de", "grey60", "#c7d4b6"))
Radial y puntos: Congreso
Este gráfico no requiere ggplot. Se realiza con el paquete base de R. Por medio de una función seats() es posible generar una cantidad determinada de puntos para recrear los asientos de un Congreso (o cualquier otra idea similar). Con color se definen los partidos políticos representados. Acá se usa el ejemplo de la conformación del Parlamento Alemán en 2013.
library(tidyr)
library(dplyr)
library(ggplot2)
setwd("~/Dropbox/PEN/BigData/EleccionesAlemania/Procesamientos_R")
Congreso <- read.csv("ComposicionParlamento.csv", sep = ";", stringsAsFactors = F)
## Sustituir sigla Brandenbur (BB) por "BR" para hacer merge con DF de mapa mas adelante
Congreso[Congreso == "BB"] <- "BR"
#Variables de conteo
Congreso$conteo <- 1
# Cantidad de diputados por partido
Diputados <- Congreso %>% select(year, party, TotalSeats) %>% group_by(year,party) %>% summarise(Total=sum(TotalSeats))
Diputados$party <- factor(Diputados$party, levels = as.character(unique(Diputados$party)))
colnames(Diputados) <- c("year", "Party", "Result")
# Se ponen NA a todos los valores en cero
Diputados[Diputados == 0] <- NA
Diputados <- na.omit(Diputados)
#############################################
# Distribucion de Asientos en el Congreso
#Congreso 2013
Congreso2013 <- Diputados %>% filter(year==2013)
Congreso2013 <- as.data.frame(Congreso2013)
Congreso2013$Party <- as.character(Congreso2013$Party)
Congreso2013[Congreso2013 == "Christian Democratic Union (CDU)"] <- "CDU+CSU"
Congreso2013[Congreso2013 == "Christian Social Union (CSU)"] <- "CDU+CSU"
Congreso2013 <- Congreso2013 %>% group_by(Party) %>% summarise(Result=sum(Result))
Congreso2013 <- arrange(Congreso2013,desc(Result))
# FUNCION PARA PLOT DEL CONGRESO
seats <- function(N,M, r0=2.5){
radii <- seq(r0, 1, len=M)
counts <- numeric(M)
pts = do.call(rbind,
lapply(1:M, function(i){
counts[i] <<- round(N*radii[i]/sum(radii[i:M]))
theta <- seq(0, pi, len = counts[i])
N <<- N - counts[i]
data.frame(x=radii[i]*cos(theta), y=radii[i]*sin(theta), r=i,
theta=theta)
} )
)
pts = pts[order(-pts$theta,-pts$r),]
pts
}
election <- function(seats, counts){
stopifnot(sum(counts)==nrow(seats))
seats$party = rep(1:length(counts),counts)
seats
}
#PLOT: 2013
layout = seats(631,16)
result = election(layout, Congreso2013$Result) # no overall majority!!!
plot(result$x, result$y,
col=c("blue", "red", "purple", "green")[result$party], #numeric index
pch=19, cex=1.8, asp=1,
frame.plot=FALSE, # gets rid of the surrounding rectangle
axes="F", # gets rid of the numbers and ticks
xlab="",
ylab="")
legend(-2.7, 3.1, legend=c("CDU+CSU (311)", "SPD (193)","Die Linke (64)", "Bündis 90/Die Grünen (63)"),
col=c( "blue", "red", "purple", "green"),
pch=19, pt.cex = 1.3, cex = 1.1 ,bty="n", y.intersp=1.1, x.intersp = .7)
Tree-map
El tree-map permite ver clasificaciones jerárquicas con subcategorías representadas por rectángulos. El tamaño de los rectángulos muestra un valor específico. En este caso se utiliza el paquete treemap para generar el gráfico, y el paquete scales para dar formato de los valores.
library(RColorBrewer)
library(treemap)
library(scales)
# Se hace el dataframe
grupo=c(rep("SOLICITARON",2),rep("NO SOLICITARON",4))
subgrupo=c("En trámite", "Rechazado", "No necesita", "No conoce", "Trámites", "Otros")
valor=c(16130, 26462, 198394, 15105, 14900, 2055)
datos=data.frame(grupo,subgrupo,valor)
#Se crea una variable que une subgrupo y el valor, para graficar
datos$label <- paste(datos$subgrupo, datos$valor, sep = ": ")
# Se crea la paleta de colores personalizada
numdata <- 2 # extension de la paleta de colores
pal <- colorRampPalette(c("steelblue", "orange2"))
colors <- pal(numdata)
## GRAFICO:
treemap(datos, index=c("grupo","label"),
vSize=c("valor"),
vColor=c("grupo"),
type="index",
palette=colors,
#palette=brewer.pal(3,"Pastel2"),
algorithm="pivotSize",
sortID = "-size", # sorting order of the rectangles
bg.labels=c("transparent"), # Background color of labels
align.labels=list(c("center", "top"), c("right", "bottom")), # Where to place labels in the rectangle?
overlap.labels=0.5, # number between 0 and 1 that determines the tolerance of the overlap between labels. 0 means that labels of lower levels are not printed if higher level labels overlap, 1 means that labels are always printed. In-between values, for instance the default value .5, means that lower level labels are printed if other labels do not overlap with more than .5 times their area size.
inflate.labels=F, # If true, labels are bigger when rectangle is bigger.
border.col=c("black","white"), # Color of borders of groups, of subgroups, of subsubgroups ....
border.lwds=c(3,3), # Width of colors
#aspRatio=1.5,
title=""
)
Redes palabras (text mining)
Las redes de palabras se usan para establecer relaciones de palabras en un texto. Son el producto de un análisis previo con técnicas de minería de texto. En este caso se utiliza el paquete tidytext para los procesamientos y la visualización requiere la combinación del paquete ggplot2 con ggraph. El código incluye varios pasos:
- limpieza de caractéres especiales del texto
- creación del set de datos en formato tidytext
- creación de los tokens (palabras separadas)
- creación de bi-grams (dos palabras)
- cración del dataframe para alimentar el gráfico, con el parámetro
graph_from_data_frame()
- creación del gráfico con
ggraph()
library(tidytext)
library(dplyr)
library(tidyr)
library(igraph)
## Leer los datos uno por uno
data <- readLines('~/Dropbox/PEN/BigData/TextMining/ProgramasGob_TextMining/2014/RProgramasGobierno/insumos/PAC.txt') # Read the data
data <- data[data != ''] # Remove the white lines
head(data)## [1] "PLAN RESCATE" "2014-2018"
## [3] "TRABAJO PROGRESO Y ALEGRÍA" "Luis Guillermo Solís Rivera"
## [5] "2014 - 2018" "Principios y Valores"# Convertir a oraciones en cada linea
library(tokenizers)
sentences <- tokenize_sentences(data)
sentences2 <- unlist(sentences)
# Se limpia el texto de caracteres especiales, y se pasa a minuscula
sentences2 <- tolower(sentences2)
#Opcion para eliminar caracteres especiales de los mensajes, y tildes.
unwanted_array <- list( 'Š'='S', 'š'='s', 'Ž'='Z', 'ž'='z', 'À'='A', 'Á'='A', 'Â'='A', 'Ã'='A', 'Ä'='A', 'Å'='A', 'Æ'='A', 'Ç'='C', 'È'='E', 'É'='E',
'Ê'='E', 'Ë'='E', 'Ì'='I', 'Í'='I', 'Î'='I', 'Ï'='I', 'Ñ'='NN', 'Ò'='O', 'Ó'='O', 'Ô'='O', 'Õ'='O', 'Ö'='O', 'Ø'='O', 'Ù'='U',
'Ú'='U', 'Û'='U', 'Ü'='U', 'Ý'='Y', 'Þ'='B', 'ß'='Ss', 'à'='a', 'á'='a', 'â'='a', 'ã'='a', 'ä'='a', 'å'='a', 'æ'='a', 'ç'='c',
'è'='e', 'é'='e', 'ê'='e', 'ë'='e', 'ì'='i', 'í'='i', 'î'='i', 'ï'='i', 'ð'='o', 'ñ'='nn', 'ò'='o', 'ó'='o', 'ô'='o', 'õ'='o',
'ö'='o', 'ø'='o', 'ù'='u', 'ú'='u', 'û'='u', 'ý'='y', 'ý'='y', 'þ'='b', 'ÿ'='y' )
string <- sentences2
sentences3 <- string
for(i in seq_along(unwanted_array))
sentences3 <- gsub(names(unwanted_array)[i],unwanted_array[i],sentences3)
# Remover los stopwords en el texto de previo (mas eficiente)
rm_words <- function(string, words) {
stopifnot(is.character(string), is.character(words))
spltted <- strsplit(string, " ", fixed = TRUE) # fixed = TRUE for speedup
vapply(spltted, function(x) paste(x[!tolower(x) %in% words], collapse = " "), character(1))
}
sentences4 <- rm_words(sentences3, tm::stopwords("es"))
# Set de datos totalmente limpio
head(sentences4)## [1] "plan rescate" "2014-2018"
## [3] "trabajo progreso alegria" "luis guillermo solis rivera"
## [5] "2014 - 2018" "principios valores"# Se crea el Tidy text
TidyText <- tibble(sentences4)
TidyText <- TidyText[!apply(TidyText == "", 1, all),] # se eliminan las filas que estan vacias
colnames(TidyText) <- "texto"
TidyText$PP <- "PAC"
# Se tokeniza por palabra
tokens <- TidyText %>%
unnest_tokens(word, texto)
# Bigrams
text_bigrams <- TidyText %>%
unnest_tokens(bigram, texto, token = "ngrams", n = 2)
# Contar bigrams
freq_bigrams <- text_bigrams %>%
count(bigram, sort = TRUE)
# Se separan los bigrams
bigrams_separated <- text_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
# new bigram counts:
bigram_counts <- bigrams_separated %>%
count(word1, word2, sort = TRUE)
# filter for only relatively common combinations
bigram_graph <- bigram_counts %>%
filter(n > 5) %>%
graph_from_data_frame()
## HACER GRAFICO DE REDES DE RELACIONES DE TEXTO MAS IMPORTANTES
library(ggplot2)
library(ggraph)
set.seed(100)
a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
ggraph(bigram_graph, layout = "fr") +
geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
arrow = a, end_cap = circle(.07, 'inches')) +
geom_node_point(color = "lightblue", size = 5) +
geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
theme_void()
Mapas geom_polygon()
La opción de mapas es altamente flexible porque se pueden usar capas propias o bien usar mapas de fuente abierta (Open Source).
Mapa de Costa Rica:
La mayor parte del trabajo en los mapas está en la conexión (merge) en un solo dataframe de las variables que se quieren representar con la información de los polígonos del mapa específico. Ver código al respecto.
library(ggplot2)
library(plotly)
library(dplyr)
library(tidyr)
library(ggthemes)
library(data.table)
source("~/Dropbox/PEN/BigData/FuncionesEspeciales.R")
#source("/Users/estadonac/Dropbox/SteffanGC/BigData/FuncionesEspeciales.R") #iMac EstadoNacion
# Se acceden a los CSV
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018/PresidencialesCanton")
ResultadosCanton <- read.csv("ResultadosTSECantonesCR(v5-2-2018).csv", sep = ";", stringsAsFactors = F, dec = ".")
BBDDCanton <- read.csv("BBDDIndicadoresCanton_v5-2-18.csv", sep = ";", stringsAsFactors = F)
setwd("~/Dropbox/PEN/BigData/EleccionesCR/HistoricoElecciones")
PartElectoral <- read.csv("PartElectoral1982_2018.csv", sep = ";", stringsAsFactors = F, check.names = F)
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018/PresidencialesCanton")
ResultadosFinales <- read.csv("ResultadosFinales_1ronda2018Canton_v31_03_18.csv", sep = ";", stringsAsFactors = F, check.names = F)
padron <- read.csv("PadronElectoralCanton2018.csv", sep = ";", stringsAsFactors = F)
colnames(padron)[4] <- "Padron_18"
padron <- padron[,c(-2,-3,-5)]
padron$Padron_18 <- as.numeric(padron$Padron_18)
## Se analiza el archivo de resultados finales del TSE, los otros son preliminares con el corte del TSE
ResultadosFinales <- ResultadosFinales[,c(1,2,3,4,5,6,7,8,10,12,14)]
colnames(ResultadosFinales)[8] <- "RN_18"
colnames(ResultadosFinales)[9] <- "PAC_18"
colnames(ResultadosFinales)[10] <- "PLN_18"
colnames(ResultadosFinales)[11] <- "PUSC_18"
# Se identifica partido ganador en 2018
ResultadosFinales <- data.table(ResultadosFinales)
ResultadosFinales <- ResultadosFinales[, Ganador_18 := colnames(.SD)[max.col(.SD, ties.method="first")], .SDcols = c("RN_18", "PAC_18", "PLN_18", "PUSC_18")]
ResultadosFinales <- as.data.frame(ResultadosFinales)
ResultadosFinales$Ganador_18 <- gsub("RN_18", "RN", ResultadosFinales$Ganador_18)
ResultadosFinales$Ganador_18 <- gsub("PAC_18", "PAC", ResultadosFinales$Ganador_18)
ResultadosFinales$Ganador_18 <- gsub("PLN_18", "PLN", ResultadosFinales$Ganador_18)
ResultadosFinales$Ganador_18 <- gsub("PUSC_18", "PUSC", ResultadosFinales$Ganador_18)
ResultadosFinales$Dif_RN_PAC <- ResultadosFinales$RN_18 - ResultadosFinales$PAC_18
ResultadosFinales$Dif_RN_PAC_porc <- round(ResultadosFinales$Dif_RN_PAC/ResultadosFinales$emitidos_18*100, digits = 1)
ResultadosFinales$Dif_PLN_RN <- ResultadosFinales$PLN_18 - ResultadosFinales$RN_18
ResultadosFinales$Dif_PLN_RN_porc <- round(ResultadosFinales$Dif_PLN_RN/ResultadosFinales$emitidos_18*100, digits = 1)
ResultadosFinales$Dif_PLN_PAC <- ResultadosFinales$PLN_18 - ResultadosFinales$PAC_18
ResultadosFinales$Dif_PLN_PAC_porc <- round(ResultadosFinales$Dif_PLN_PAC/ResultadosFinales$emitidos_18*100, digits = 1)
ResultadosFinales$Dif_PUSC_RN <- ResultadosFinales$PUSC_18 - ResultadosFinales$RN_18
ResultadosFinales$Dif_PUSC_RN_porc <- round(ResultadosFinales$Dif_PUSC_RN/ResultadosFinales$emitidos_18*100, digits = 1)
ResultadosFinales$Dif_PUSC_PAC <- ResultadosFinales$PUSC_18 - ResultadosFinales$PAC_18
ResultadosFinales$Dif_PUSC_PAC_porc <- round(ResultadosFinales$Dif_PUSC_PAC/ResultadosFinales$emitidos_18*100, digits = 1)
ResultadosFinales$CantonRep <- ResultadosFinales$Canton
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018/PresidencialesCanton")
ResultadosCanton <- read.csv("ResultadosTSECantonesCR(v5-2-2018).csv", sep = ";", stringsAsFactors = F, dec = ".")
# Se filtran los datos solo para algunos partidos
#partidos <- c("RESTAURACIÓN NACIONAL", "ACCIÓN CIUDADANA", "LIBERACIÓN NACIONAL", "UNIDAD SOCIAL CRISTIANA")
Partidos <- ResultadosCanton
# Se cambian los nombres
colnames(Partidos) <- c("Provincia", "Canton", "Partido", "Votos", "Porcentaje")
Partidos$Partido <- gsub("RESTAURACIÓN NACIONAL", "RN_18", Partidos$Partido)
Partidos$Partido <- gsub("ACCIÓN CIUDADANA", "PAC_18", Partidos$Partido)
Partidos$Partido <- gsub("LIBERACIÓN NACIONAL", "PLN_18", Partidos$Partido)
Partidos$Partido <- gsub("UNIDAD SOCIAL CRISTIANA", "PUSC_18", Partidos$Partido)
Partidos$Partido <- gsub("INTEGRACIÓN NACIONAL", "PIN_18", Partidos$Partido)
Partidos$Partido <- gsub("REPUBLICANO SOCIALCRISTIANO", "PRSC_18", Partidos$Partido)
Partidos$Partido <- gsub("MOVIMIENTO LIBERTARIO", "ML_18", Partidos$Partido)
Partidos$Partido <- gsub("NUEVA GENERACIÓN", "PNG_18", Partidos$Partido)
Partidos$Partido <- gsub("FRENTE AMPLIO", "FA_18", Partidos$Partido)
Partidos$Partido <- gsub("RENOVACIÓN COSTARRICENSE", "RC_18", Partidos$Partido)
Partidos$Partido <- gsub("ALIANZA DEMÓCRATA CRISTIANA", "ADC_18", Partidos$Partido)
Partidos$Partido <- gsub("ACCESIBILIDAD SIN EXCLUSIÓN", "PASE_18", Partidos$Partido)
Partidos$Partido <- gsub("DE LOS TRABAJADORES", "PT_18", Partidos$Partido)
# Se cambia formato de DF
PartidosDF <- Partidos[,c(-4)]
PartidosDF$Porcentaje <- gsub('.{1}$', '', PartidosDF$Porcentaje) # Elimina el último caracter que es "%"
PartidosDF$Porcentaje <- as.numeric(PartidosDF$Porcentaje)
PartidosDF <- spread(PartidosDF, key = "Partido", value = "Porcentaje")
PartidosDF <- PartidosDF[,c(-1)]
PartidosDF$Canton <- gsub("San Jose", "San José", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Escazu", "Escazú", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Tarrazu", "Tarrazú", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Aserri", "Aserrí", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Vazquez de Coronado", "Vásquez de Coronado", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Tibas", "Tibás", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Perez Zeledón", "Pérez Zeledón", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Leon Cortes ", "León Cortés", PartidosDF$Canton)
PartidosDF$Canton <- gsub("San Ramon", "San Ramón", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Poas", "Poás", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Paraiso", "Paraíso", PartidosDF$Canton)
PartidosDF$Canton <- gsub("La Union", "La Unión", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Jimenez", "Jiménez", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Santa Barbara", "Santa Bárbara", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Belen", "Belén", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Sarapiqui", "Sarapiquí", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Cannas", "Cañas", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Tilaran", "Tilarán", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Montes De Oro", "Montes de Oro", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Limon", "Limón", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Pococi", "Pococí", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Guacimo", "Guácimo", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Montes de oca", "Montes de Oca", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Zarcero", "Alfaro Ruiz", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Quepos", "Aguirre", PartidosDF$Canton)
PartidosDF$Canton <- gsub("Coto brus", "Coto Brus", PartidosDF$Canton)
##################################################################################################################
BBDDCanton$Canton <- gsub("Montes De Oro", "Montes de Oro", BBDDCanton$Canton)
BBDDCanton$Canton <- gsub("Vázquez de Coronado", "Vásquez de Coronado", BBDDCanton$Canton)
## Se filtra BBDD de participación electoral
PE2018 <- PartElectoral %>% select(Canton, `2018`) %>% filter(Canton != "Costa Rica")
colnames(PE2018)[2] <- "Participacion_18"
## Se hace el join de los dos dataframes
BaseConsolidada <- left_join(BBDDCanton, PartidosDF, by="Canton")
BaseConsolidada <- left_join(BaseConsolidada, PE2018, by= "Canton")
# Se agrega el padrón de 2018 por cantón
BaseConsolidada <- left_join(BaseConsolidada, padron, by= "Codigo")
# Se identifica partido ganador en 2014 y en 2018
BaseConsolidada <- data.table(BaseConsolidada)
BaseConsolidada <- BaseConsolidada[, Ganador_14 := colnames(.SD)[max.col(.SD, ties.method="first")], .SDcols = c("PLN_14", "ML_14", "PAC_14", "FA_14")]
BaseConsolidada <- BaseConsolidada[, Ganador_18 := colnames(.SD)[max.col(.SD, ties.method="first")], .SDcols = c("ADC_18", "FA_18", "ML_18", "PAC_18", "PASE_18", "PIN_18", "PLN_18", "PNG_18", "PRSC_18", "PT_18", "PUSC_18", "RC_18", "RN_18")]
BaseConsolidada <- as.data.frame(BaseConsolidada)
# Se cambia nombre a partidos
BaseConsolidada$Ganador_18 <- gsub("RN_18", "RN", BaseConsolidada$Ganador_18)
BaseConsolidada$Ganador_18 <- gsub("PUSC_18", "PUSC", BaseConsolidada$Ganador_18)
BaseConsolidada$Ganador_18 <- gsub("PLN_18", "PLN", BaseConsolidada$Ganador_18)
BaseConsolidada$Ganador_18 <- gsub("PAC_18", "PAC", BaseConsolidada$Ganador_18)
BaseConsolidada$Ganador_14 <- gsub("PAC_14", "PAC", BaseConsolidada$Ganador_14)
BaseConsolidada$Ganador_14 <- gsub("PLN_14", "PLN", BaseConsolidada$Ganador_14)
BaseConsolidada$Ganador_14 <- gsub("FA_14", "FA", BaseConsolidada$Ganador_14)
# Se hace una columna de comparación partido ganador 2014 y 2018
BaseConsolidada$balance <- ifelse(BaseConsolidada$Ganador_14 == BaseConsolidada$Ganador_18, "TRUE", "FALSE")
BaseConsolidada$CantonRep <- BaseConsolidada$Canton
## Votos por partido en primera ronda de 2018
VotosPartido <- ResultadosCanton %>% group_by(Partido.político) %>% summarise(Total=sum(Votos))
Padron2018 <- sum(BaseConsolidada$Padron_18)
VotosPartido$Porc <- round(VotosPartido$Total/Padron2018*100, digits = 1)
## Cantones ganados por RN
RNGanador <- BaseConsolidada %>% filter(Ganador_18 == "RN") %>% select(Codigo, Provincia, Canton, RN_18, PAC_18, PLN_18)
RNGanador$Dif_RN_PAC_18 <- RNGanador$RN_18 - RNGanador$PAC_18
RNGanador <- RNGanador %>% arrange(Dif_RN_PAC_18)
## Cantones ganados por PAC
PACGanador <- BaseConsolidada %>% filter(Ganador_18 == "PAC") %>% select(Codigo, Provincia, Canton, RN_18, PAC_18, PLN_18)
PACGanador$Dif_PAC_RN_18 <- PACGanador$PAC_18 - PACGanador$RN_18
PACGanador <- PACGanador %>% arrange(Dif_PAC_RN_18)
## Cantones ganados por PLN
PLNGanador <- BaseConsolidada %>% filter(Ganador_18 == "PLN") %>% select(Codigo, Provincia, Canton, RN_18, PAC_18, PLN_18, PUSC_18)
PLNGanador$Dif_PLN_RN_18 <- PLNGanador$PLN_18 - PLNGanador$RN_18
PLNGanador$Dif_PLN_PAC_18 <- PLNGanador$PLN_18 - PLNGanador$PAC_18
## Cantones ganados por PUSC
PUSCGanador <- BaseConsolidada %>% filter(Ganador_18 == "PUSC") %>% select(Codigo, Provincia, Canton, RN_18, PAC_18, PLN_18, PUSC_18)
PUSCGanador$Dif_PUSC_RN_18 <- PUSCGanador$PUSC_18 - PUSCGanador$RN_18
PUSCGanador$Dif_PUSC_PAC_18 <- PUSCGanador$PUSC_18 - PUSCGanador$PAC_18
## Se filtran los datos de diferencias para unirla a Base Consolidada, y luego graficarlas en Cartograma
Dif_RN_PAC_18DF <- RNGanador[,c(3,7)]
Dif_PAC_RN_18DF <- PACGanador[,c(3,7)]
Dif_PLN_RN_18DF <- PLNGanador[,c(3,8)]
Dif_PLN_PAC_18DF <- PLNGanador[,c(3,9)]
Dif_PUSC_RN_18DF <- PUSCGanador[,c(3,8)]
Dif_PUSC_PAC_18DF <- PUSCGanador[,c(3,9)]
BaseConsolidada <- left_join(BaseConsolidada, Dif_RN_PAC_18DF, by= "Canton")
BaseConsolidada <- left_join(BaseConsolidada, Dif_PAC_RN_18DF, by= "Canton")
BaseConsolidada <- left_join(BaseConsolidada, Dif_PLN_RN_18DF, by= "Canton")
BaseConsolidada <- left_join(BaseConsolidada, Dif_PLN_PAC_18DF, by= "Canton")
BaseConsolidada <- left_join(BaseConsolidada, Dif_PUSC_RN_18DF, by= "Canton")
BaseConsolidada <- left_join(BaseConsolidada, Dif_PUSC_PAC_18DF, by= "Canton")
##############################################################
### MAPA de Partido Ganador por cantón
##############################################################
library(sp)
library(ggplot2)
library(rgdal)
library(rgeos)
library(maptools)
library(RColorBrewer)
library(stringr)
library(dplyr)
library(tidyr)
library(ggrepel) # editar etiquetas de Cantón
library(plotly)
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018/MAPA_CR_Capas")
#setwd("/Users/estadonac/Dropbox/SteffanGC/BigData/EleccionesCR/2018/MAPA_CR_Capas") #ACCESO en iMac EstadoNacion
## Leer el archivo mapa con los Estados de Alemania descargado de internet: http://www.gadm.org/country
mapa <- readRDS("CRI_adm2.rds")
# add to data a new column termed "id" composed of the rownames of data
mapa@data$id <- rownames(mapa@data)
# create a data.frame from our spatial object
mapaPoints <- fortify(mapa, region = "id")
# merge the "fortified" data with the data from our spatial object
mapaDF <- merge(mapaPoints, mapa@data, by = "id")
# Mapa sin la Isla del Coco para graficar
mapaDF2 <- mapaDF %>% filter(lat > 6)
## DF PartidoGanador por Cantón
PartidoGanador <- BaseConsolidada[,c(5,78)]
# Cambiar nombre a variable para merge
colnames(PartidoGanador) <- c("NAME_2", "Ganador")
# Merge de dataframes
mapaFinal <- merge(mapaDF2, PartidoGanador, by="NAME_2")
### MAPA completo
ggplot(data = mapaFinal, aes(x=long, y=lat, group = group, fill = Ganador)) +
geom_polygon() +
geom_path(color = "black", size=.1) +
scale_fill_manual("", values = c("PAC"= "gold1","PLN"="yellowgreen", "PUSC"="red", "RN"="steelblue"), breaks= c("RN", "PAC", "PLN", "PUSC"), labels= c("RN: 46% (37) ", "PAC: 37% (30) ", "PLN: 13% (11) ", "PUSC: 4% (3)")) +
coord_equal() +
labs(title= "Costa Rica: Mapa de partido ganador en la primera ronda de la elección presidencial de 2018, por cantón",
subtitle= "Resultados preliminares") +
theme(legend.position = "none", title = element_blank(),axis.text = element_blank()) +
theme_minimal() +
theme(axis.ticks = element_blank(), axis.title = element_blank(), axis.text = element_blank(), panel.grid = element_blank()) +
theme(legend.text = element_text(size = 13), legend.position = "top")
Mapa de otros países (ejemplo: Alemania):
Desde ggplot es posible realizar mapas de cualquier parte del mundo mientras se tenga acceso a los polígonos de la región que interesa visualizar. En el sitio web http://www.gadm.org/country es posible descargar polígonos de diversos países. El mapa que sigue utiliza como ejemplo el caso de Alemania, y se distingue en color los Estado del Este y Oeste, antes de la unificación.
library(sp)
library(ggplot2)
library(rgdal)
library(rgeos)
library(maptools)
library(RColorBrewer)
library(stringr)
setwd("~/Dropbox/PEN/BigData/EleccionesAlemania/Procesamientos_R")
## Leer el archivo mapa con los Estados de Alemania descargado de internet: http://www.gadm.org/country
mapa <- readRDS("DEU_adm1.rds")
# add to data a new column termed "id" composed of the rownames of data
mapa@data$id <- rownames(mapa@data)
# create a data.frame from our spatial object
mapaPoints <- fortify(mapa, region = "id")
# merge the "fortified" data with the data from our spatial object
mapaDF <- merge(mapaPoints, mapa@data, by = "id")
## Variable para estados del Este y Oeste
mapaDF$region <- ifelse(mapaDF$ID_1 == 3 | mapaDF$ID_1 == 4 |mapaDF$ID_1 == 8 |mapaDF$ID_1 == 13 |mapaDF$ID_1 == 14 |mapaDF$ID_1 == 16, "Este", "Oeste")
### MAPA por región (Este-Oeste)
ggplot(data = mapaDF, aes(x=long, y=lat, group = group, fill = region)) +
geom_polygon() +
scale_fill_manual("Región:", values = c("Oeste"="lightsalmon2", "Este"="grey50")) +
geom_path(color = "white") +
coord_equal() +
theme(legend.position = "none", title = element_blank(),axis.text = element_blank()) +
theme_minimal() +
ggtitle("Alemania: Mapa de estados del este y oeste alemán") +
theme(axis.ticks = element_blank(), axis.title = element_blank(), axis.text = element_blank(), panel.grid = element_blank())
Cartograma de Costa Rica:
También es posible realizar cartogramas que deforman la división administrativa del país (provincia, cantón o distritos) de acuerdo con alguna variable de interés. Típicamente se utiliza la población para deformar la unidad geográfica.
El siguiente mapa muestra el partido ganador en la segunda ronda electoral de 2018 en cada cantón, y se deforma de acuerdo con la cantidad de electores empadronados en los 81 municipios. El código incluye tres pasos:
- Preparación de la variable de interés, en este caso el padrón por cantón.
- Proceso de transformación de los polígonos de acuerdo con la variable de interés.
- Ploteo del mapa con todos los atributos. En este caso, partido ganador en cada cantón.
Para reproducirlo en sistema Mac OS, se requiere la instalación de varios paquetes en la bases del sistema que permiten hacer la transformación de las capas del polígono. Los pasos se pueden consultar en este link: https://goo.gl/iNsjJx
##################################################################
# Segunda ronda: Cartograma partido ganador por cantón
##################################################################
##Install the R implementation of Cart by Gastner and Newman (2004)
#devtools::install_github("omegahat/Rcartogram")
#1devtools::install_github('chrisbrunsdon/getcartr',subdir='getcartr')
library(ggplot2)
library(plotly)
library(dplyr)
library(tidyr)
library(ggthemes)
library(data.table)
source("~/Dropbox/PEN/BigData/FuncionesEspeciales.R")
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018")
SegundaRonda <- read.csv("GanadorSegundaRonda2018.csv", sep = ";")
padron <- read.csv("PadronElectoralCanton2018.csv", sep = ";", stringsAsFactors = F)
colnames(padron)[4] <- "Padron_18"
padron <- padron[,c(-2,-3,-5)]
padron$Padron_18 <- as.numeric(padron$Padron_18)
SegundaRonda <- left_join(SegundaRonda, padron, by="Codigo")
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018/MAPA_CR_Capas")
# Loading packages and data
library(Rcartogram)
library(getcartr)
library(ggplot2)
## Leer el archivo mapa con los Estados de Alemania descargado de internet: http://www.gadm.org/country
mapa <- readRDS("CRI_adm2.rds")
setwd("~/Dropbox/PEN/BigData/EleccionesCR/2018")
## Create a smaller dataset by retaining the world's population in 2013 and the ISO3
## country code, which will be used for matching and merging with the input shapefile
smaller.data <- data.frame(Canton.Name = SegundaRonda$Canton, Padron = SegundaRonda$Padron_18, Ganador = SegundaRonda$Ganador)
smaller.data <- na.omit(smaller.data)
## Join the two datasets using their common field
matched.indices <- match(mapa@data[, "NAME_2"], smaller.data[, "Canton.Name"])
mapa@data <- data.frame(mapa@data, smaller.data[matched.indices, ])
## Compute the cartogram transformation of each country using its population
## with the degree of Gaussian blur = 0.5 (otherwise, it may not work)
mapa.carto <- quick.carto(mapa, mapa@data$Padron, blur = 1.06) #blur puede variarse si da error de intersección más abajo
## Convert the object into data frame
mapa.f <- fortify(mapa.carto, region = "Canton.Name")
## Merge the cartogram transformation with the world map shapefile
mapa.f <- merge(mapa.f, mapa@data, by.x = "id", by.y = "Canton.Name")
# Mapa sin la Isla del Coco para graficar
mapa.f <- mapa.f %>% filter(lat > 6)
## Make a plot of the transformed polygons, where each country is
## further shaded by their population size (lighter means bigger)
ggplot(mapa.f, aes(long, lat, group = group, fill = mapa.f$Ganador)) + geom_polygon() +
geom_path(color = "black", size=.1) +
scale_fill_manual("", values = c("PAC"= "gold1","RN"="steelblue"), breaks= c("PAC", "RN"), labels= c("PAC: 77% (62) ", "RN: 23% (19)")) +
coord_equal() +
theme(legend.position = "none", title = element_blank(),axis.text = element_blank()) +
theme_minimal() +
ggtitle("Costa Rica: Cartograma de partido ganador en la segunda ronda de la elección presidencial de 2018, por cantón") +
theme(axis.ticks = element_blank(), axis.title = element_blank(), axis.text = element_blank(), panel.grid = element_blank()) +
theme(legend.text = element_text(size = 13), legend.position = "top")
Mapa interactivo (leaflet):
Con el paquete leaflet es posible realizar mapas interactivos que permiten seleccionar las categorías de interés y hacer zoom sobre zonas específicas. El código se basa en programación por capas: primero las características generales y el proveedor del mapa addProviderTiles(), que en este caso es OpenStreetMap. Luego se programan los atributos de interés con el parámetro addCircles(), seguido de un panel de selección con addLayersControl() para las categorías. Finalmente se plotea el mapa.
Acá se usa un ejemplo de big data que considera la información del servicio de emergencias 9-1-1 con 1,4 millones de datos para 18 meses.
suppressWarnings(suppressMessages(library(ggplot2)))
suppressWarnings(suppressMessages(library(tidyr)))
suppressWarnings(suppressMessages(library(dplyr)))
suppressWarnings(suppressMessages(library(leaflet)))
suppressWarnings(suppressMessages(library(ggmap)))
suppressWarnings(suppressMessages(library(htmlwidgets)))
suppressWarnings(suppressMessages(library(stringr)))
setwd("~/Dropbox/PEN/BigData/911_SGC/BBDD_911")
# Se cargan los datos en formato .RData
load("Base911conGPS.RData")
#Se da formato a hora, minuto y segundo con formato numérico para que queden en ordern
datos$Hora <- as.numeric(datos$Hora)
datos$Min <- as.numeric(datos$Min)
datos$Seg <- as.numeric(datos$Seg)
# Se ordenan factores de provincia, canton y distrito
datos$ProvinciaLab <- as.factor(datos$ProvinciaLab)
levels(datos$ProvinciaLab) <- list("San Jose" = "1", "Alajuela" = "2",
"Cartago" = "3", "Heredia" = "4",
"Guanacaste" = "5", "Puntarenas" = "6",
"Limon" = "7")
#Da formato de fecha a la columna Fecha
datos$Fecha <- as.Date(datos$Fecha)
#Se ordenan los niveles de la variable weekday recién creada
datos$weekday <- as.factor(datos$weekday)
datos$weekday <- ordered(datos$weekday, levels = c("Monday", "Tuesday",
"Wednesday", "Thursday", "Friday",
"Saturday", "Sunday"))
#Se reordenan los niveles de MesAño
datos$MesAño <- as.factor(datos$MesAño)
levels(datos$MesAño) <- list("Set-2015" = "9/2015",
"Oct-2015" = "10/2015",
"Nov-2015" = "11/2015",
"Dic-2015" = "12/2015",
"Ene-2016" = "1/2016",
"Feb-2016" = "2/2016",
"Mar-2016" = "3/2016",
"Abr-2016" = "4/2016",
"May-2016" = "5/2016",
"Jun-2016" = "6/2016",
"Jul-2016" = "7/2016",
"Ago-2016" = "8/2016",
"Set-2016" = "9/2016",
"Oct-2016" = "10/2016",
"Nov-2016" = "11/2016",
"Dic-2016" = "12/2016",
"Ene-2017" = "1/2017")
#Se ordena de mayor a menor los levels de Alcance para que queden graficados en orden.
datos$IncRecod <- as.factor(datos$IncRecod)
datos$IncRecod <- ordered(datos$IncRecod, levels = c("medica", "transito", "violencia",
"famsex", "denuncias", "sospecha",
"drogas", "menoresedad", "propiedad",
"ambiental", "otros"))
#Se eliminan los NA en el set de datos (se eliminan 5829 filas)
datos <- na.omit(datos)
# Mapa de incidentes en distritos por Incidentes per Cápita y tipo de incidente
# Se hace un subset de las emergencias por cada tipo de incidente
medicaPC <- subset(datos, IncRecod == "medica", select = c("gpsLab","IncPercapita", "conteo", "lon", "lat")) %>% group_by(gpsLab,IncPercapita, lon, lat) %>% summarise(conteo=sum(conteo))
transitoPC <- subset(datos, IncRecod == "transito", select = c("gpsLab","IncPercapita", "conteo", "lon", "lat")) %>% group_by(gpsLab,IncPercapita, lon, lat) %>% summarise(conteo=sum(conteo))
violenciaPC <- subset(datos, IncRecod == "violencia", select = c("gpsLab","IncPercapita", "conteo", "lon", "lat")) %>% group_by(gpsLab,IncPercapita, lon, lat) %>% summarise(conteo=sum(conteo))
famsexPC <- subset(datos, IncRecod == "famsex", select = c("gpsLab","IncPercapita", "conteo", "lon", "lat")) %>% group_by(gpsLab,IncPercapita, lon, lat) %>% summarise(conteo=sum(conteo))
denunciasPC <- subset(datos, IncRecod == "denuncias", select = c("gpsLab","IncPercapita", "conteo", "lon", "lat")) %>% group_by(gpsLab,IncPercapita, lon, lat) %>% summarise(conteo=sum(conteo))
#Creando un mapa interactivo con leaflet, utilizando la variable "conteo" como escala creamos una escala de tonos rojos.
pal <- colorNumeric(palette = c("blue2","orange","red"), domain = transitoPC$IncPercapita)
mapa2 <- leaflet() %>%
addTiles() %>%
addProviderTiles(providers$OpenStreetMap.France) %>%
setView(lng = -84.06695, lat = 9.935994, zoom = 8) %>%
# Overlay groups
addCircles(lng = medicaPC$lon, lat = medicaPC$lat,#Indicamos la latitud y longitud de las marcas MEDICA
weight = 5,
radius = medicaPC$IncPercapita, # Indicamos el radio de nuestra marca.
popup = str_c("<b>Distrito:</b>",
medicaPC$gpsLab,
"<b>Cantidad incidentes per capita:</b>",
medicaPC$IncPercapita,
sep="<br/>"),# Indicamos le información que debe mostrarse al hacer clic sobre una marca.
color = pal(medicaPC$IncPercapita), # Indicamos la paleta de color a utilizar.
group = "MedicaPC"
) %>%
addCircles(lng = transitoPC$lon, lat = transitoPC$lat,#Indicamos la latitud y longitud de las marcaS TRANSITO
weight = 5,
radius = transitoPC$IncPercapita, # Indicamos el radio de nuestra marca.
popup = str_c("<b>Distrito:</b>",
transitoPC$gpsLab,
"<b>Cantidad incidentes per capita:</b>",
transitoPC$IncPercapita,
sep="<br/>"),# Indicamos le información que debe mostrarse al hacer clic sobre una marca.
color = pal(transitoPC$IncPercapita), # Indicamos la paleta de color a utilizar.
group = "TransitoPC"
) %>%
addCircles(lng = violenciaPC$lon, lat = violenciaPC$lat,#Indicamos la latitud y longitud de las marcaS TRANSITO
weight = 5,
radius = violenciaPC$IncPercapita, # Indicamos el radio de nuestra marca.
popup = str_c("<b>Distrito:</b>",
violenciaPC$gpsLab,
"<b>Cantidad incidentes per capita:</b>",
violenciaPC$IncPercapita,
sep="<br/>"),# Indicamos le información que debe mostrarse al hacer clic sobre una marca.
color = pal(violenciaPC$IncPercapita), # Indicamos la paleta de color a utilizar.
group = "ViolenciaPC"
) %>%
addCircles(lng = famsexPC$lon, lat = famsexPC$lat,#Indicamos la latitud y longitud de las marcaS TRANSITO
weight = 5,
radius = famsexPC$IncPercapita, # Indicamos el radio de nuestra marca.
popup = str_c("<b>Distrito:</b>",
famsexPC$gpsLab,
"<b>Cantidad incidentes per capita:</b>",
famsexPC$IncPercapita,
sep="<br/>"),# Indicamos le información que debe mostrarse al hacer clic sobre una marca.
color = pal(famsexPC$IncPercapita), # Indicamos la paleta de color a utilizar.
group = "Familiar-sexualPC"
) %>%
addCircles(lng = denunciasPC$lon, lat = denunciasPC$lat,#Indicamos la latitud y longitud de las marcaS TRANSITO
weight = 5,
radius = denunciasPC$IncPercapita, # Indicamos el radio de nuestra marca.
popup = str_c("<b>Distrito:</b>",
denunciasPC$gpsLab,
"<b>Cantidad incidentes per capita:</b>",
denunciasPC$IncPercapita,
sep="<br/>"),# Indicamos le información que debe mostrarse al hacer clic sobre una marca.
color = pal(denunciasPC$IncPercapita), # Indicamos la paleta de color a utilizar.
group = "DenunciasPC"
) %>%
# Layers control
addLayersControl(
baseGroups = "Emergencias en 911",
overlayGroups = c("MedicaPC", "TransitoPC","ViolenciaPC", "Familiar-sexualPC", "DenunciasPC"),
options = layersControlOptions(collapsed = FALSE)
) %>%
addLegend(position = "bottomright",# posición de la leyenda en el mapa (inferior derecha)
pal = pal, # paleta de colores a utilizar
values = transitoPC$IncPercapita, # datos con lo que se creara la escala
title = "Cantidad per cápita", # titulo de la leyanda
opacity = .9 # nivel de transparencia
)
# Se grafica el mapa con todos los parámetros definidos previamente
mapa2Bibliografía
Wickham, Hadley (2010). A Layered Grammar of Graphics. American Statistical Association, Institute of Mathematical Statistics, and Interface Foundation of North America. Journal of Computational and Graphical Statistics, Volume 19, Number 1, Pages 3–28.
Wilkinson, Leland. (2005). The Grammar of Graphics (2nd ed.). Statistics and Computing, New York: Springer. [14,18]