Diego Sebastián Luyo León · Estefanía Diana Carolina Apaza Díaz — Estadística para el Análisis Político II, PUCP
Por qué up-sampling: el down-sampling iguala clases eliminando ~69% de las protestas pacíficas originales, perdiendo heterogeneidad. El up-sampling conserva el 100% de la información original y muestra métricas de sensibilidad/especificidad igualmente estables.
“La probabilidad de que una protesta social escale hacia la violencia en el Perú responde a las condiciones estructurales y los incentivos institucionales determinados por cada periodo político y sus respectivos ejecutivos.”
Validada. Los nueve predictores del modelo son estadísticamente significativos (p < 0.001, salvo eventos previos p < 0.01).
---
title: "Estructuras de oportunidad y acción colectiva"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: scroll
theme:
version: 4
bootswatch: journal
source_code: embed
---
```{r setup, include=FALSE}
# ============================================================
# Si es la primera vez que usas estos paquetes en Posit Cloud,
# corre esto UNA VEZ en la Consola (no en un chunk):
#
# install.packages(c("flexdashboard", "tidyverse", "plotly", "DT", "broom", "scales"))
# ============================================================
library(flexdashboard)
library(tidyverse)
library(plotly)
library(DT)
library(broom)
library(scales)
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
# Paleta del proyecto (misma lógica que el panel HTML: verde-azulado = baja
# violencia, óxido = alta violencia)
color_ink <- "#1c2b3a"
color_oxide <- "#a23e28"
color_slate <- "#2f6a63"
color_paper <- "#e7e4da"
```
```{r carga-datos}
# Misma fuente que el .Rnw original (Base de Eventos de Protesta del Perú)
link_egpp <- "https://docs.google.com/spreadsheets/d/e/2PACX-1vR9hUSJf257WLVR3UUb50fPIXjLx_HlsNcp6rth5i5_fST9KYV1uPkfoDbU0MnfTrIIAs_SWYF_5TCB/pub?output=csv"
data <- read.csv(link_egpp)
# Dummies para tipo de actor
data$actor_laboral <- ifelse(data$categoria_actor == "actor_laboral", 1, 0)
data$actor_territorial_social <- ifelse(data$categoria_actor == "actor_territorial_social", 1, 0)
data$actor_economico <- ifelse(data$categoria_actor == "actor_economico", 1, 0)
data$actor_estudiantil <- ifelse(data$categoria_actor == "actor_estudiantil", 1, 0)
data$actor_politico_ciudadano <- ifelse(data$categoria_actor == "actor_politico_ciudadano", 1, 0)
# Dummies para periodos políticos
data$periodo_pre90 <- ifelse(data$ano < 1990, 1, 0)
data$periodo_90_00 <- ifelse(data$ano >= 1990 & data$ano <= 2000, 1, 0)
data$periodo_01_16 <- ifelse(data$ano >= 2001 & data$ano <= 2016, 1, 0)
data$periodo_actual <- ifelse(data$ano > 2016, 1, 0)
# Etiqueta legible de periodo, para los gráficos descriptivos
data <- data %>%
mutate(periodo_label = case_when(
ano <= 1989 ~ "Previo a 1990",
ano >= 1990 & ano <= 2000 ~ "Fujimori (1990-2000)",
ano >= 2001 & ano <= 2016 ~ "Regreso a la democracia (2001-2016)",
ano >= 2017 ~ "Autoritarismo parlamentario (2017-)"
)) %>%
mutate(periodo_label = factor(periodo_label, levels = c(
"Previo a 1990", "Fujimori (1990-2000)",
"Regreso a la democracia (2001-2016)", "Autoritarismo parlamentario (2017-)"
)))
# Dataframe para el modelo
Y <- data$violencia_y
X_model <- data %>%
select(periodo_pre90, periodo_90_00, periodo_01_16,
actor_laboral, actor_territorial_social, actor_economico, actor_estudiantil,
protesta_masiva, numero_eventos_previos)
data_modelo <- cbind(protesta_violenta = Y, X_model)
```
```{r resampleo-y-modelo}
# ---- Up-sampling (método elegido en el trabajo final) ----
pacificas <- data_modelo[data_modelo$protesta_violenta == 0, ]
violentas <- data_modelo[data_modelo$protesta_violenta == 1, ]
set.seed(123)
replicated_violentas <- violentas[sample(1:nrow(violentas), nrow(pacificas), replace = TRUE), ]
balanced_data <- rbind(pacificas, replicated_violentas)
modelo_up <- glm(
protesta_violenta ~ periodo_pre90 + periodo_90_00 + periodo_01_16 +
actor_laboral + actor_territorial_social + actor_economico + actor_estudiantil +
protesta_masiva + numero_eventos_previos,
data = balanced_data, family = binomial()
)
pred_prob_up <- predict(modelo_up, type = "response")
pred_class_up <- ifelse(pred_prob_up > 0.5, 1, 0)
actual_up <- balanced_data$protesta_violenta
accuracy_up <- mean(pred_class_up == actual_up) * 100
sensitivity_up <- sum(pred_class_up == 1 & actual_up == 1) / sum(actual_up == 1) * 100
specificity_up <- sum(pred_class_up == 0 & actual_up == 0) / sum(actual_up == 0) * 100
# ---- Down-sampling (comparación) ----
wins_down <- data_modelo[data_modelo$protesta_violenta == 1, ]
losses_down <- data_modelo[data_modelo$protesta_violenta == 0, ]
set.seed(123)
replicated_losses <- losses_down[sample(1:nrow(losses_down), nrow(wins_down), replace = FALSE), ]
balanced_data_down <- rbind(replicated_losses, wins_down)
modelo_down <- glm(
protesta_violenta ~ periodo_pre90 + periodo_90_00 + periodo_01_16 +
actor_laboral + actor_territorial_social + actor_economico + actor_estudiantil +
protesta_masiva + numero_eventos_previos,
data = balanced_data_down, family = binomial()
)
pred_prob_down <- predict(modelo_down, type = "response")
pred_class_down <- ifelse(pred_prob_down > 0.5, 1, 0)
actual_down <- balanced_data_down$protesta_violenta
accuracy_down <- mean(pred_class_down == actual_down) * 100
sensitivity_down <- sum(pred_class_down == 1 & actual_down == 1) / sum(actual_down == 1) * 100
specificity_down <- sum(pred_class_down == 0 & actual_down == 0) / sum(actual_down == 0) * 100
# ---- Odds Ratios + IC 95% (modelo up-sampled) ----
or_table <- tidy(modelo_up, conf.int = TRUE, exponentiate = TRUE) %>%
filter(term != "(Intercept)")
# ---- Efectos Marginales Promedio (AME), calculados a mano ----
ame_dummy <- function(var){
d1 <- balanced_data; d1[[var]] <- 1
d0 <- balanced_data; d0[[var]] <- 0
mean(predict(modelo_up, newdata = d1, type = "response") -
predict(modelo_up, newdata = d0, type = "response")) * 100
}
ame_continua <- function(var){
d1 <- balanced_data; d1[[var]] <- balanced_data[[var]] + 1
mean(predict(modelo_up, newdata = d1, type = "response") -
predict(modelo_up, newdata = balanced_data, type = "response")) * 100
}
dummy_vars <- c("periodo_pre90", "periodo_90_00", "periodo_01_16",
"actor_laboral", "actor_territorial_social", "actor_economico", "actor_estudiantil",
"protesta_masiva")
ame_values <- sapply(dummy_vars, ame_dummy)
ame_values["numero_eventos_previos"] <- ame_continua("numero_eventos_previos")
ame_df <- tibble(term = names(ame_values), ame = as.numeric(ame_values))
# Etiquetas legibles para el modelo
label_map <- c(
periodo_pre90 = "Periodo: Pre-1990",
periodo_90_00 = "Periodo: 1990-2000 (Fujimori)",
periodo_01_16 = "Periodo: 2001-2016",
actor_laboral = "Actor: Laboral",
actor_territorial_social = "Actor: Territorial/social",
actor_economico = "Actor: Económico",
actor_estudiantil = "Actor: Estudiantil",
protesta_masiva = "Control: Protesta masiva",
numero_eventos_previos = "Control: Eventos previos (+1)"
)
modelo_final <- or_table %>%
left_join(ame_df, by = "term") %>%
mutate(label = label_map[term]) %>%
arrange(estimate)
```
Resumen
=======================================================================
Row {data-height=40}
-----------------------------------------------------------------------
###
```{r}
htmltools::tags$p("Diego Sebastián Luyo León · Estefanía Diana Carolina Apaza Díaz — Estadística para el Análisis Político II, PUCP",
style = "color:#6b675c; font-size:13px; margin:0;")
```
Row {data-height=130}
-----------------------------------------------------------------------
### Eventos registrados
```{r}
valueBox(comma(nrow(data)), icon = "fa-list", color = color_ink)
```
### % que escaló a violencia
```{r}
pct_viol <- round(mean(data$violencia_y) * 100, 2)
valueBox(paste0(pct_viol, "%"), icon = "fa-fire", color = color_oxide)
```
### Concentrados en Lima
```{r}
pct_lima <- round(mean(data$region == "Lima") * 100, 2)
valueBox(paste0(pct_lima, "%"), icon = "fa-map-marker-alt", color = color_ink)
```
### Periodo de mayor riesgo
```{r}
riskiest <- data %>% group_by(periodo_label) %>%
summarise(rate = mean(violencia_y) * 100) %>%
arrange(desc(rate)) %>% slice(1)
valueBox(paste0(round(riskiest$rate,1), "%"), icon = "fa-exclamation-triangle", color = color_oxide)
```
Row {data-height=450}
-----------------------------------------------------------------------
### Eventos y tasa de violencia por periodo político
```{r}
periodo_summary <- data %>%
group_by(periodo_label) %>%
summarise(n = n(), tasa = mean(violencia_y) * 100)
p <- ggplot(periodo_summary, aes(x = periodo_label, y = n, fill = tasa,
text = paste0(periodo_label, "<br>N = ", comma(n), "<br>Tasa violencia = ", round(tasa,1), "%"))) +
geom_col() +
scale_fill_gradient(low = color_slate, high = color_oxide, name = "% violencia") +
labs(x = NULL, y = "N° de eventos") +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 15, hjust = 1))
ggplotly(p, tooltip = "text")
```
Row {data-height=450}
-----------------------------------------------------------------------
### Eventos de protesta y tasa de violencia por año
```{r}
year_summary <- data %>%
group_by(ano) %>%
summarise(n = n(), tasa = mean(violencia_y) * 100)
plot_ly(year_summary, x = ~ano) %>%
add_bars(y = ~n, name = "Eventos", marker = list(color = color_ink, opacity = 0.75),
hovertemplate = "Año %{x}<br>Eventos: %{y}<extra></extra>") %>%
add_lines(y = ~tasa, name = "Tasa de violencia (%)", yaxis = "y2",
line = list(color = color_oxide, width = 2),
hovertemplate = "Año %{x}<br>Tasa: %{y:.1f}%<extra></extra>") %>%
layout(
yaxis = list(title = "N° de eventos"),
yaxis2 = list(overlaying = "y", side = "right", title = "% violencia", rangemode = "tozero"),
xaxis = list(title = NULL),
legend = list(orientation = "h", y = 1.1)
)
```
Actores y regiones
=======================================================================
Row
-----------------------------------------------------------------------
### Tasa de violencia según tipo de actor
```{r}
actor_labels <- c(
actor_laboral = "Actor laboral",
actor_territorial_social = "Actor territorial/social",
actor_economico = "Actor económico",
actor_estudiantil = "Actor estudiantil",
actor_politico_ciudadano = "Actor político-ciudadano"
)
actor_summary <- data %>%
filter(categoria_actor %in% names(actor_labels)) %>%
group_by(categoria_actor) %>%
summarise(n = n(), tasa = mean(violencia_y) * 100) %>%
mutate(actor = actor_labels[categoria_actor]) %>%
arrange(tasa)
p2 <- ggplot(actor_summary, aes(x = reorder(actor, tasa), y = tasa, fill = tasa,
text = paste0(actor, "<br>N = ", comma(n), "<br>Tasa = ", round(tasa,1), "%"))) +
geom_col() +
coord_flip() +
scale_fill_gradient(low = color_slate, high = color_oxide, guide = "none") +
labs(x = NULL, y = "% de eventos violentos") +
theme_minimal(base_size = 12)
ggplotly(p2, tooltip = "text")
```
### Regiones con más eventos (top 10)
```{r}
region_summary <- data %>%
group_by(region) %>%
summarise(n = n(), tasa = mean(violencia_y) * 100) %>%
arrange(desc(n)) %>%
slice(1:10)
p3 <- ggplot(region_summary, aes(x = reorder(region, n), y = n,
text = paste0(region, "<br>N = ", comma(n), "<br>Tasa violencia = ", round(tasa,1), "%"))) +
geom_col(fill = color_ink, alpha = 0.8) +
coord_flip() +
labs(x = NULL, y = "N° de eventos") +
theme_minimal(base_size = 12)
ggplotly(p3, tooltip = "text")
```
Modelo
=======================================================================
Row {data-height=550}
-----------------------------------------------------------------------
### Odds Ratios (IC 95%) — regresión logística, up-sampling
```{r}
p4 <- ggplot(modelo_final, aes(x = reorder(label, estimate), y = estimate,
ymin = conf.low, ymax = conf.high, color = estimate > 1,
text = paste0(label, "<br>OR = ", round(estimate,2),
"<br>IC 95%: [", round(conf.low,2), ", ", round(conf.high,2), "]"))) +
geom_hline(yintercept = 1, linetype = "dashed", color = "grey60") +
geom_pointrange() +
coord_flip() +
scale_y_log10() +
scale_color_manual(values = c(`TRUE` = color_oxide, `FALSE` = color_slate), guide = "none") +
labs(x = NULL, y = "Odds Ratio (escala log)") +
theme_minimal(base_size = 12)
ggplotly(p4, tooltip = "text")
```
### Efecto Marginal Promedio (puntos porcentuales)
```{r}
p5 <- ggplot(modelo_final, aes(x = reorder(label, ame), y = ame, fill = ame > 0,
text = paste0(label, "<br>AME = ", round(ame,2), " pp"))) +
geom_col() +
geom_hline(yintercept = 0, color = "grey40") +
coord_flip() +
scale_fill_manual(values = c(`TRUE` = color_oxide, `FALSE` = color_slate), guide = "none") +
labs(x = NULL, y = "AME (puntos porcentuales)") +
theme_minimal(base_size = 12)
ggplotly(p5, tooltip = "text")
```
Row {data-height=250}
-----------------------------------------------------------------------
### Tabla completa del modelo (up-sampling)
```{r}
modelo_final %>%
transmute(Variable = label, OR = round(estimate, 3),
`IC 2.5%` = round(conf.low, 3), `IC 97.5%` = round(conf.high, 3),
`AME (pp)` = round(ame, 3), `p-valor` = signif(p.value, 3)) %>%
datatable(options = list(dom = "t", pageLength = 10), rownames = FALSE)
```
Remuestreo
=======================================================================
Row {data-height=130}
-----------------------------------------------------------------------
### Accuracy — Down-sampling
```{r}
valueBox(paste0(round(accuracy_down,2), "%"), icon = "fa-balance-scale", color = color_slate)
```
### Accuracy — Up-sampling (elegido)
```{r}
valueBox(paste0(round(accuracy_up,2), "%"), icon = "fa-check-circle", color = color_oxide)
```
### N final — Down-sampling
```{r}
valueBox(comma(nrow(balanced_data_down)), icon = "fa-database", color = color_slate)
```
### N final — Up-sampling
```{r}
valueBox(comma(nrow(balanced_data)), icon = "fa-database", color = color_oxide)
```
Row
-----------------------------------------------------------------------
### Comparación de métricas de rendimiento
```{r}
tibble(
Métrica = c("Precisión global (accuracy)", "Sensibilidad", "Especificidad", "N final"),
`Down-sampling` = c(paste0(round(accuracy_down,2),"%"), paste0(round(sensitivity_down,2),"%"),
paste0(round(specificity_down,2),"%"), comma(nrow(balanced_data_down))),
`Up-sampling (elegido)` = c(paste0(round(accuracy_up,2),"%"), paste0(round(sensitivity_up,2),"%"),
paste0(round(specificity_up,2),"%"), comma(nrow(balanced_data)))
) %>%
datatable(options = list(dom = "t"), rownames = FALSE)
```
> **Por qué up-sampling:** el down-sampling iguala clases eliminando ~69% de las protestas pacíficas originales, perdiendo heterogeneidad. El up-sampling conserva el 100% de la información original y muestra métricas de sensibilidad/especificidad igualmente estables.
Conclusiones
=======================================================================
Row
-----------------------------------------------------------------------
### H1 — Hipótesis de trabajo
> "La probabilidad de que una protesta social escale hacia la violencia en el Perú responde a las condiciones estructurales y los incentivos institucionales determinados por cada periodo político y sus respectivos ejecutivos."
**Validada.** Los nueve predictores del modelo son estadísticamente significativos (p < 0.001, salvo eventos previos p < 0.01).
### Hallazgos principales
- El **periodo previo a 1990** es el de mayor riesgo estructural frente al periodo actual (2016 en adelante).
- El **fujimorismo (1990–2000)** es el único periodo que reduce el riesgo base, consistente con un aparato autocrático que desmoviliza mediante control y cooptación.
- Los **actores territoriales/sociales** tienen el mayor impacto agregado por su alta representatividad; los **estudiantes** muestran la mayor volatilidad relativa.
- Los actores **laborales y económicos**, con mayor capacidad organizativa formal, actúan como factores de mitigación.
- **Limitación:** la cobertura de prensa nacional subrepresenta eventos en la periferia rural, y el up-sampling duplica la varianza del grupo minoritario.