library(rio)
empresas = import("2019_directorio_rucs.xlsx")
contratos = import("contratos_region_2019.xlsx")
str(contratos)
## 'data.frame': 326 obs. of 8 variables:
## $ REGION : chr "AMAZONAS" "AMAZONAS" "AMAZONAS" "AMAZONAS" ...
## $ FECHA : POSIXct, format: "2020-10-01" "2019-11-27" ...
## $ EMPRESA_1: num 2.03e+10 2.05e+10 2.06e+10 2.05e+10 2.05e+10 ...
## $ EMPRESA_2: num NA NA 2.05e+10 NA 2.05e+10 ...
## $ EMPRESA_3: num NA NA NA NA NA NA NA NA NA NA ...
## $ EMPRESA_4: num NA NA NA NA NA NA NA NA NA NA ...
## $ EMPRESA_5: num NA NA NA NA NA NA NA NA NA NA ...
## $ MONTO : chr "1,606,886.41" "198,407.09" "3,348,900.00" "1,540,000.00" ...
str(empresas)
## 'data.frame': 452 obs. of 5 variables:
## $ RUC : chr "20270971891" "2.0479840688E10" "2.0561152005E10" "2.0487499685E10" ...
## $ DNI_REP_LEGAL: chr "1.6768197E7" "09075782" "4.3419729E7" "4.454137E7" ...
## $ NOMBRE : chr "BARBOZA MONTALVO ANGEL EDGARDO" "MUÑOZ RUBIO CESAR" "CIEZA TORRES REYLE" "TUESTA SANTILLAN MARIO" ...
## $ FECHA_INICIO : POSIXct, format: "1995-07-01" "2005-03-16" ...
## $ DIRECC : chr "CAL.ZARUMILLA NRO. 1131 INT. 201 SEC. JAEN CAJAMARCA - JAEN - JAEN" "PROL GRAU NRO. 1255 (FACHADA AZUL ELECTRICO 2DO PISO) AMAZONAS - CHACHAPOYAS - CHACHAPOYAS" "JR. SANTA LUCIA NRO. 256 URB. CHACHAPOYAS (PRIMER PISO) AMAZONAS - CHACHAPOYAS - CHACHAPOYAS" "JR. LIBERTAD NRO. 1236 BARR. LUYA URCO AMAZONAS - CHACHAPOYAS - CHACHAPOYAS" ...
# =========================================================
# 0) Paquetes y opciones
# =========================================================
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.2
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(lubridate)
library(janitor)
##
## Adjuntando el paquete: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(scales)
##
## Adjuntando el paquete: 'scales'
##
## The following object is masked from 'package:purrr':
##
## discard
##
## The following object is masked from 'package:readr':
##
## col_factor
library(forcats)
options(scipen = 999)
# =========================================================
# 1) Limpieza mínima y preparación (usa tus data.frames)
# contratos: REGION, FECHA (POSIXct), EMPRESA_1..5 (num), MONTO (chr)
# empresas : RUC (chr, puede venir en notación científica), etc.
# =========================================================
# a) Normaliza nombres de columnas
contratos <- contratos %>% clean_names()
empresas <- empresas %>% clean_names()
# b) Parseo robusto de monto y filtro 2019
contratos <- contratos %>%
mutate(
fecha = as.Date(fecha),
anio = year(fecha),
# convierte "1,234,567.89" o "1.234.567,89" → numerico
monto_chr = as.character(monto),
monto_us = readr::parse_number(monto_chr, locale = readr::locale(grouping_mark = ",", decimal_mark = ".")),
monto_eu = readr::parse_number(monto_chr, locale = readr::locale(grouping_mark = ".", decimal_mark = ",")),
monto = if_else(is.na(monto_us), monto_eu, monto_us),
.keep = "unused"
) %>%
filter(anio == 2019)
stopifnot(is.numeric(contratos$monto))
# c) Pasa empresas a formato largo (EMPRESA_1..5) y normaliza RUC a texto
emp_cols <- intersect(names(contratos), paste0("empresa_", 1:5))
df_long <- contratos %>%
mutate(contrato_id = row_number()) %>%
pivot_longer(all_of(emp_cols), names_to = "slot", values_to = "ruc_num") %>%
filter(!is.na(ruc_num)) %>%
mutate(
ruc = sprintf("%.0f", as.numeric(ruc_num)) # evita notación científica
) %>%
select(region, contrato_id, ruc, monto)
# d) Limpieza básica de "empresas" (RUC en texto puro, por si luego lo usas)
empresas <- empresas %>%
mutate(
ruc = gsub("[^0-9]", "", as.character(ruc)), # quita puntos, 'E10', etc.
ruc = sub("^0+", "", ruc) # sin ceros a la izquierda
)
# =========================================================
# 2) Métricas regionales 2019
# =========================================================
# Empresas únicas activas por región
empresas_region <- df_long %>%
group_by(region) %>%
summarise(empresas_unicas = n_distinct(ruc), .groups = "drop")
# Contratos y monto total por región
contratos_region <- contratos %>%
group_by(region) %>%
summarise(
n_contratos = n(),
monto_total = sum(monto, na.rm = TRUE),
.groups = "drop"
)
# HHI por región (usando MONTOS)
hhi_region <- df_long %>%
group_by(region, ruc) %>%
summarise(monto_emp = sum(monto, na.rm = TRUE), .groups = "drop_last") %>%
mutate(monto_region = sum(monto_emp, na.rm = TRUE),
share = monto_emp / pmax(monto_region, 1e-12)) %>%
summarise(HHI = sum(share^2), .groups = "drop")
# Panel con índices
indices_region <- contratos_region %>%
left_join(empresas_region, by = "region") %>%
left_join(hhi_region, by = "region") %>%
mutate(
idx_ctos_por_emp = n_contratos / pmax(empresas_unicas, 1),
idx_monto_por_emp= monto_total / pmax(empresas_unicas, 1),
idx_monto_prom = monto_total / pmax(n_contratos, 1),
HHI_pct = HHI * 100
)
# =========================================================
# 3) Helpers de presentación
# =========================================================
theme_apoyo <- function(base_size = 12){
theme_minimal(base_size = base_size) +
theme(
plot.title.position = "plot",
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, color = "grey30"),
panel.grid.minor = element_blank(),
legend.position = "none"
)
}
lab_millones <- label_number(accuracy = 0.1, big.mark = ",",
decimal_mark = ".", scale = 1e-6, suffix = " M")
barh <- function(data, x, y, title, subtitle = NULL, x_lab = "", lab_fun = waiver()){
ggplot(data, aes(x = {{ x }}, y = fct_reorder({{ y }}, {{ x }}), fill = {{ x }})) +
geom_col(width = 0.7) +
geom_text(aes(label = if (is.function(lab_fun)) lab_fun({{ x }}) else {{ x }}),
hjust = -0.12, size = 3.2, color = "grey10") +
coord_cartesian(xlim = c(0, max(dplyr::pull(data, {{ x }}), na.rm = TRUE) * 1.12)) +
scale_fill_viridis_c(option = "D", end = 0.95) +
scale_x_continuous(labels = if (is.function(lab_fun)) lab_fun else lab_fun,
expand = expansion(mult = c(0, .08))) +
labs(title = title, subtitle = subtitle, x = x_lab, y = NULL, caption = "Fuente: SEACE (2019)") +
theme_apoyo()
}
# =========================================================
# 4) Los 4 gráficos solicitados (2019)
# =========================================================
# (1) HHI por región (en %)
p_hhi <- barh(
indices_region,
x = HHI_pct, y = region,
title = "Concentración por región (HHI con montos)",
subtitle = "0% = atomizado • 100% = máximo",
x_lab = "HHI (0–100%)",
lab_fun = label_percent(scale = 1, accuracy = 0.1)
)
# (2) Contratos por empresa
p_ctos_emp <- barh(
indices_region,
x = idx_ctos_por_emp, y = region,
title = "Intensidad de contratación",
subtitle = "Contratos adjudicados / Empresas únicas (2019)",
x_lab = "Contratos por empresa",
lab_fun = label_number(accuracy = 0.1)
)
# (3) Monto por empresa
p_monto_emp <- barh(
indices_region,
x = idx_monto_por_emp, y = region,
title = "Monto adjudicado por empresa",
subtitle = "Monto total / Empresas únicas (2019)",
x_lab = "S/ por empresa (millones)",
lab_fun = lab_millones
)
# (4) Monto promedio por contrato
p_monto_prom <- barh(
indices_region,
x = idx_monto_prom, y = region,
title = "Tamaño medio de contrato",
subtitle = "Monto total / N.º de contratos (2019)",
x_lab = "S/ por contrato (millones)",
lab_fun = lab_millones
)
p_hhi
p_ctos_emp
p_monto_emp
p_monto_prom
