expo_1
APOYO Comunicación - Asuntos Públicos
2025-09-24
library(rio)
empresas = import("2019_directorio_rucs.xlsx")
df = import("contratos_region_2019.xlsx")
names(df) <- janitor::make_clean_names(names(df)) # =========================================================
# CONTRATOS DE OBRAS PÚBLICAS 2019 — Script completo
# =========================================================
# ---- Paquetes ----
library(rio) # import
library(tidyverse) # dplyr, ggplot2, tidyr, readr, etc.
library(lubridate)
library(janitor)
library(stringr)
library(scales)
library(treemapify)
library(tidygraph)
library(ggraph)
library(forcats)
options(scipen = 999) # evita notación científica 1.2e6
# ---- Carga de data ----
empresas <- import("2019_directorio_rucs.xlsx") # si la necesitas luego
df <- import("contratos_region_2019.xlsx")
# ---- Normaliza nombres y crea alias robustos ----
df <- df %>%
rename_with(~ janitor::make_clean_names(.x)) %>%
rename(
region = any_of(c("region","REGION")),
fecha = any_of(c("fecha","FECHA")),
monto = any_of(c("monto","MONTO")),
empresa_1 = any_of(c("empresa_1","EMPRESA_1")),
empresa_2 = any_of(c("empresa_2","EMPRESA_2")),
empresa_3 = any_of(c("empresa_3","EMPRESA_3")),
empresa_4 = any_of(c("empresa_4","EMPRESA_4")),
empresa_5 = any_of(c("empresa_5","EMPRESA_5"))
)
# ---- Limpieza de columnas clave ----
df <- df %>%
mutate(
# Fecha robusta (intenta ymd y dmy)
fecha = suppressWarnings(ymd(fecha)),
fecha = if_else(is.na(fecha), suppressWarnings(dmy(fecha)), fecha),
# Monto: acepta "1,540,000.00" o "1.540.000,00" y variantes
monto = as.character(monto),
monto_num_us = parse_number(monto, locale = locale(grouping_mark = ",", decimal_mark = ".")),
monto_num_eu = parse_number(monto, locale = locale(grouping_mark = ".", decimal_mark = ",")),
monto = if_else(is.na(monto_num_us), monto_num_eu, monto_num_us),
.keep = "unused" # elimina columnas auxiliares
) %>%
mutate(
anio = year(fecha),
mes = floor_date(fecha, "month"),
contrato_id = row_number()
)
# ---- Verificación mínima ----
stopifnot(is.numeric(df$monto))
# ---- Larga de empresas (1..5) ----
emp_cols <- intersect(names(df), paste0("empresa_", 1:5)) # por si faltan
df_long <- df %>%
pivot_longer(all_of(emp_cols), names_to = "pos", values_to = "empresa") %>%
mutate(
empresa = na_if(trimws(as.character(empresa)), "NA"),
empresa = if_else(empresa == "" | empresa == "0", NA_character_, empresa)
) %>%
filter(!is.na(empresa))
# ---- Flag de consorcio por contrato ----
consorcios <- df_long %>%
group_by(contrato_id) %>%
summarise(n_empresas = n_distinct(empresa), .groups = "drop") %>%
mutate(es_consorcio = n_empresas > 1)
df_base <- df %>% left_join(consorcios, by = "contrato_id")
# =========================================================
# Helpers de estilo (títulos centrados, ejes en millones)
# =========================================================
theme_apoyo <- function(base_size = 12, base_family = NULL) {
theme_minimal(base_size = base_size, base_family = base_family) +
theme(
plot.title.position = "plot",
plot.caption.position = "plot",
plot.title = element_text(hjust = 0.5, face = "bold", size = base_size + 2),
plot.subtitle= element_text(hjust = 0.5, margin = margin(b = 8)),
plot.caption = element_text(hjust = 1, face = "italic", color = "grey30"),
axis.title.y = element_text(margin = margin(r = 8)),
axis.title.x = element_text(margin = margin(t = 8)),
panel.grid.minor = element_blank()
)
}
lab_millones <- label_number(
accuracy = 0.1, big.mark = ",", decimal.mark = ".",
scale = 1e-6, suffix = " M"
)
scale_y_millones <- function(...) scale_y_continuous(labels = lab_millones, ...)
scale_x_millones <- function(...) scale_x_continuous(labels = lab_millones, ...)
pal_cont <- scale_fill_viridis_c(option = "D", end = 0.95)
pal_cont_c <- scale_color_viridis_c(option = "D", end = 0.95)
pal_disc <- scale_fill_viridis_d(option = "D", end = 0.95)Contratos
1. Monto total por región
p1 <- df %>%
group_by(region) %>%
summarise(monto_total = sum(monto, na.rm = TRUE), n = n(), .groups = "drop") %>%
arrange(desc(monto_total)) %>%
ggplot(aes(x = reorder(region, monto_total), y = monto_total, fill = monto_total)) +
geom_col(width = 0.7) +
coord_flip() +
pal_cont +
scale_y_millones() +
labs(
title = "¿Qué regiones adjudicaron más en 2019?",
subtitle = "Monto total adjudicado por región",
x = "Región", y = "Monto total (S/ millones)",
caption = "Fuente: SEACE"
) +
theme_apoyo() +
theme(legend.position = "none")
p1
2. Estacionalidad mensual
p2 <- df %>%
group_by(mes) %>%
summarise(monto_total = sum(monto, na.rm = TRUE), n_contratos = n(), .groups = "drop") %>%
ggplot(aes(mes, monto_total)) +
geom_line(linewidth = 1) +
geom_point(size = 2) +
pal_cont_c +
scale_y_millones() +
labs(
title = "Evolución mensual de montos adjudicados",
subtitle = "Contrataciones de obras públicas — 2019",
x = "Mes", y = "Monto total (S/ millones)",
caption = "Fuente: SEACE"
) +
theme_apoyo()
p2
3. Top 15 empresas por monto (desagregando consorcios)
top_empresas <- df_long %>%
group_by(empresa) %>%
summarise(monto_total = sum(monto, na.rm = TRUE),
n_contratos = n_distinct(contrato_id), .groups = "drop") %>%
slice_max(monto_total, n = 15) %>%
arrange(monto_total)
p3 <- ggplot(top_empresas, aes(x = reorder(empresa, monto_total), y = monto_total, fill = monto_total)) +
geom_col(width = 0.7) +
coord_flip() +
pal_cont +
scale_y_millones() +
labs(
title = "Top 15 empresas por monto adjudicado",
subtitle = "Incluye contratos en consorcio",
x = "Empresa", y = "Monto (S/ millones)",
caption = "Fuente: SEACE"
) +
theme_apoyo() +
theme(legend.position = "none")
p3
4. Tamaño de contrato por región
p4 <- df %>%
ggplot(aes(x = reorder(region, monto, FUN = median, na.rm = TRUE), y = monto)) +
geom_boxplot(outlier.alpha = 0.15, fill = "#3B82F6", color = "grey25") +
coord_flip() +
scale_y_millones() +
labs(
title = "¿Qué regiones adjudican contratos más grandes?",
subtitle = "Distribución de montos por contrato (mediana como referencia)",
x = "Región", y = "Monto por contrato (S/ millones)",
caption = "Fuente: SEACE"
) +
theme_apoyo()
p4
5. Heatmap región x mes
p5 <- df %>%
group_by(region, mes) %>%
summarise(monto_total = sum(monto, na.rm = TRUE), .groups = "drop") %>%
ggplot(aes(mes, fct_reorder(region, monto_total, .fun = sum), fill = monto_total)) +
geom_tile() +
pal_cont +
labs(
title = "Intensidad de gasto por región y mes",
subtitle = "Heatmap de montos adjudicados (2019)",
x = "Mes", y = "Región", fill = "Monto",
caption = "Fuente: SEACE"
) +
theme_apoyo()
p5
6. Treemap por región
p6 <- df %>%
group_by(region) %>%
summarise(monto_total = sum(monto, na.rm = TRUE), .groups = "drop") %>%
ggplot(aes(
area = monto_total,
fill = monto_total,
label = paste0(region, "\n", lab_millones(monto_total))
)) +
geom_treemap(color = "white", linewidth = 0.5) +
geom_treemap_text(place = "centre", reflow = TRUE, min.size = 8) +
pal_cont +
labs(
title = "Concentración de montos por región",
subtitle = "Cada rectángulo es proporcional al monto total adjudicado (2019)",
caption = "Fuente: SEACE"
) +
theme_apoyo() +
theme(legend.position = "none")
p6
7. Índice de concentración (HHI) por región
hhi_region <- df_long %>%
group_by(region, empresa) %>%
summarise(monto_emp = sum(monto, na.rm = TRUE), .groups = "drop_last") %>%
mutate(
monto_region = sum(monto_emp, na.rm = TRUE),
share = monto_emp / monto_region
) %>%
summarise(HHI = sum(share^2, na.rm = TRUE), .groups = "drop")
p7 <- ggplot(hhi_region, aes(x = reorder(region, HHI), y = HHI, fill = HHI)) +
geom_col(width = 0.7) +
coord_flip() +
pal_cont +
labs(
title = "Concentración de adjudicaciones por región",
subtitle = "Índice Herfindahl-Hirschman (0 = atomizado, 1 = máximo)",
x = "Región", y = "HHI",
caption = "Fuente: SEACE"
) +
theme_apoyo() +
theme(legend.position = "none")
p7
Empresas
# ================================
# EMPRESAS: exploración y gráficos
# ================================
library(rio)
library(tidyverse)
library(lubridate)
library(janitor)
library(scales)
library(forcats)
library(stringr)
library(tidygraph)
library(ggraph)
options(scipen = 999)
# ---- 1) Carga y limpieza básica ----
empresas <- import("2019_directorio_rucs.xlsx")
empresas <- empresas %>%
rename_with(~ make_clean_names(.x)) %>% # ruc, dni_rep_legal, nombre, fecha_inicio, direcc
mutate(
ruc = str_trim(as.character(ruc)),
dni_rep_legal = str_trim(as.character(dni_rep_legal)),
nombre = str_to_title(str_squish(as.character(nombre))),
fecha_inicio = suppressWarnings(ymd(fecha_inicio)),
fecha_inicio = if_else(is.na(fecha_inicio), suppressWarnings(dmy(fecha_inicio)), fecha_inicio),
# normaliza dirección
direcc = str_squish(as.character(direcc))
)
# ---- 2) Extraer DEPARTAMENTO / PROVINCIA / DISTRITO desde DIRECC ----
# Regla: tomar SIEMPRE los 3 ÚLTIMOS segmentos separados por " - " (con o sin espacios)
split_tail3 <- function(x) {
parts <- str_split(x, "\\s*-\\s*")
# extrae con tail; si no hay suficientes, devuelve NA
tibble(
departamento = map_chr(parts, ~ if (length(.x) >= 3) .x[[length(.x)-2]] else NA_character_),
provincia = map_chr(parts, ~ if (length(.x) >= 2) .x[[length(.x)-1]] else NA_character_),
distrito = map_chr(parts, ~ if (length(.x) >= 1) .x[[length(.x) ]] else NA_character_)
)
}
ubi <- split_tail3(empresas$direcc) %>%
mutate(
departamento = str_to_title(str_squish(departamento)),
provincia = str_to_title(str_squish(provincia)),
distrito = str_to_title(str_squish(distrito))
)
empresas <- bind_cols(empresas, ubi)
# ---- 3) Campos derivados ----
empresas <- empresas %>%
mutate(
anio_inicio = year(fecha_inicio),
mes_inicio = floor_date(fecha_inicio, "month"),
# edad a cierre 2019 (o usa hoy() si prefieres)
edad_anios = interval(fecha_inicio, ymd("2019-12-31")) / years(1)
)
# ---- 4) Tema y helpers (si no lo tienes ya definido) ----
theme_apoyo <- function(base_size = 12, base_family = NULL) {
theme_minimal(base_size = base_size, base_family = base_family) +
theme(
plot.title.position = "plot",
plot.caption.position = "plot",
plot.title = element_text(hjust = 0.5, face = "bold", size = base_size + 2),
plot.subtitle= element_text(hjust = 0.5, margin = margin(b = 8)),
plot.caption = element_text(hjust = 1, face = "italic", color = "grey30"),
panel.grid.minor = element_blank()
)
}
pal_cont <- scale_fill_viridis_c(option = "D", end = 0.95)
pal_disc <- scale_fill_viridis_d(option = "D", end = 0.95)
pal_cont_c <- scale_color_viridis_c(option = "D", end = 0.95)Serie anual de creación
g1 <- empresas %>%
filter(!is.na(anio_inicio)) %>%
count(anio_inicio) %>%
ggplot(aes(anio_inicio, n)) +
geom_line(linewidth = 1) +
geom_point(size = 2) +
pal_cont_c +
labs(
title = "Creación de empresas por año",
subtitle = "Cantidad de empresas con contratos, según año de inicio",
x = "Año de inicio", y = "Número de empresas",
caption = "Fuente: SEACE"
) +
theme_apoyo()
g1
Estacionalidad (mes de creación)
g2 <- empresas %>%
filter(!is.na(mes_inicio)) %>%
count(mes_inicio) %>%
ggplot(aes(mes_inicio, n)) +
geom_col() +
pal_cont +
labs(
title = "Estacionalidad de creación de empresas",
subtitle = "Conteo mensual",
x = "Mes de inicio", y = "Número de empresas",
caption = "Fuente: SEACE"
) +
theme_apoyo()
g2
Edad de las empresas
g4 <- empresas %>%
filter(!is.na(edad_anios) & edad_anios >= 0) %>%
ggplot(aes(edad_anios)) +
geom_histogram(bins = 30, fill = "#3B82F6", color = "grey30") +
labs(
title = "Edad de las empresas (a 2019)",
subtitle = "Años desde la constitución",
x = "Edad (años)", y = "Número de empresas",
caption = "Fuente: SEACE"
) +
theme_apoyo()
g4
Representantes con más de 1 empresa (posible riesgo)
rep_multi <- empresas %>%
filter(!is.na(dni_rep_legal), dni_rep_legal != "NA") %>%
distinct(dni_rep_legal, ruc) %>%
count(dni_rep_legal, name = "n_empresas") %>%
filter(n_empresas >= 2) %>%
arrange(desc(n_empresas)) %>%
slice_head(n = 15)
g5 <- rep_multi %>%
mutate(dni_rep_legal = fct_reorder(dni_rep_legal, n_empresas)) %>%
ggplot(aes(dni_rep_legal, n_empresas, fill = n_empresas)) +
geom_col(width = 0.7) +
coord_flip() +
pal_cont +
labs(
title = "Representantes legales con múltiples empresas",
subtitle = "Top 15 por número de RUC asociados",
x = "DNI del representante legal", y = "N.º de empresas",
caption = "Fuente: SEACE"
) +
theme_apoyo() +
theme(legend.position = "none")
g5
Top 25 empresas con más contratos
# (Opcional) tema y paleta rápidos
theme_apoyo <- function(base_size = 12){
theme_minimal(base_size = base_size) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = base_size + 2),
plot.subtitle= element_text(hjust = 0.5),
plot.caption = element_text(hjust = 1),
panel.grid.minor = element_blank(),
legend.position = "none"
)
}
# --- 0) Asegura nombres y un ID de contrato (si no lo tienes ya hecho) ---
df <- df %>%
rename_with(~ make_clean_names(.x)) %>%
rename(
region = any_of(c("region","REGION")),
fecha = any_of(c("fecha","FECHA")),
monto = any_of(c("monto","MONTO")),
empresa_1 = any_of(c("empresa_1","EMPRESA_1")),
empresa_2 = any_of(c("empresa_2","EMPRESA_2")),
empresa_3 = any_of(c("empresa_3","EMPRESA_3")),
empresa_4 = any_of(c("empresa_4","EMPRESA_4")),
empresa_5 = any_of(c("empresa_5","EMPRESA_5"))
) %>%
mutate(contrato_id = row_number())
# --- 1) Pasa empresas a formato largo y limpia ---
emp_cols <- intersect(names(df), paste0("empresa_", 1:5))
df_long <- df %>%
pivot_longer(all_of(emp_cols), names_to = "pos", values_to = "empresa") %>%
mutate(
empresa = na_if(trimws(as.character(empresa)), "NA"),
empresa = if_else(empresa == "" | empresa == "0", NA_character_, empresa)
) %>%
filter(!is.na(empresa)) %>%
distinct(empresa, contrato_id) # evita dobles por la misma empresa-contrato
# --- 2) Cuenta contratos por empresa y arma el Top 25 ---
top25_empresas_ctos <- df_long %>%
count(empresa, name = "n_contratos", sort = TRUE) %>%
slice_max(n_contratos, n = 10) %>%
arrange(n_contratos) %>%
mutate(empresa = fct_reorder(empresa, n_contratos))
# (Opcional) Si tienes el data frame `empresas` con razón social/representante,
# puedes enriquecer la etiqueta. Ejemplo (si RUC está en `empresa`):
# top25_empresas_ctos <- top25_empresas_ctos %>%
# left_join(empresas %>% transmute(empresa = as.character(ruc),
# etiqueta = paste0(ruc, " — ", nombre)),
# by = "empresa") %>%
# mutate(empresa = if_else(!is.na(etiqueta), etiqueta, empresa))
# --- 3) Gráfico ---
g_top25 <- ggplot(top25_empresas_ctos,
aes(x = empresa, y = n_contratos, fill = n_contratos)) +
geom_col(width = 0.7) +
coord_flip() +
scale_fill_viridis_c(option = "D", end = 0.95) +
labs(
title = "Top 25 empresas con más contratos",
subtitle = "Cuenta de contratos adjudicados en 2019\n(Consorcios: 1 contrato por empresa integrante)",
x = "Empresa (RUC)", y = "Número de contratos",
caption = "Fuente: SEACE"
) +
theme_apoyo()
g_top25
## Número de contratos por región
df <- df %>%
rename_with(~ make_clean_names(.x)) %>%
rename(
region = any_of(c("region","REGION")),
monto = any_of(c("monto","MONTO"))
)
# (opcional) parsea MONTO a numérico si aún es texto
df <- df %>%
mutate(
monto = as.character(monto),
monto_us = readr::parse_number(monto, locale = readr::locale(grouping_mark = ",", decimal_mark = ".")),
monto_eu = readr::parse_number(monto, locale = readr::locale(grouping_mark = ".", decimal_mark = ",")),
monto = if_else(is.na(monto_us), monto_eu, monto_us)
) %>%
select(-monto_us, -monto_eu)
# 2) Tabla: contratos por región (y monto total opcional)
contratos_por_region <- df %>%
filter(!is.na(region) & region != "") %>%
group_by(region) %>%
summarise(
n_contratos = n(),
monto_total = sum(monto, na.rm = TRUE), # quita esta línea si no quieres monto
.groups = "drop"
) %>%
arrange(desc(n_contratos))
ggplot(contratos_por_region,
aes(x = reorder(region, n_contratos), y = n_contratos, fill = n_contratos)) +
geom_col(width = 0.7) +
coord_flip() +
scale_fill_viridis_c(option = "D", end = 0.95) +
labs(
title = "Número de contratos por región (2019)",
subtitle = "Conteo de contratos adjudicados",
x = "Región", y = "N.º de contratos",
caption = "Fuente: SEACE"
) +
theme_apoyo()