Nota metodológica sobre calidad de datos. Esta base presenta limitaciones estructurales documentadas en el diagnóstico de calidad (González Lozano & Granados Rodríguez, agosto 2026). Los problemas más críticos son: (1) el 48% de las filas son potencialmente duplicadas por re-ingesta de lotes del sistema de cargue, problema que no puede resolverse completamente con la información disponible; (2) 58 transacciones tienen fechas futuras no eliminadas; (3) 8 valores de año de inicio son imposibles. Todo el análisis que sigue aplica los filtros de limpieza disponibles y declara explícitamente los supuestos adoptados. Los resultados deben interpretarse como exploratorios.

0. Librerías y carga de datos

library(tidyverse)    # manipulación y visualización
library(readxl)       # lectura de Excel
library(scales)       # formato de ejes
library(ggridges)     # density ridges
library(broom)        # tidying de modelos
library(knitr)        # tablas
library(kableExtra)   # formato de tablas
library(corrplot)     # correlaciones
library(patchwork)    # combinar gráficas
library(writexl)      # exportar Excel

# Paleta institucional
COL_POS  <- "#1baf7a"   # flujo positivo
COL_NEG  <- "#e34948"   # flujo negativo
COL_AZUL <- "#1A5276"   # color principal
COL_GRIS <- "#898781"   # secundario

# ── PREREQUISITO ─────────────────────────────────────────────────────────────
# Este script asume que ya corrite limpieza_MDF.Rmd,  que produce:
#   ig_limpia.csv  — base de ingresos y gastos limpia y estandarizada
#   Caracterizacion limpia — se limpia aquí directamente (es más pequeña)
#
# Si aún no has corrido limpieza_MDF.Rmd, hazlo primero por fis 

ig_limpia <- read_csv("ig_limpia.csv", show_col_types = FALSE) %>%
  mutate(`Fecha de la transacción` = as.Date(`Fecha de la transacción`))

car <- read_excel("Base_Anonimizada_Caracterizacion.xlsx",
                  sheet = "Caracterizacion")

# Limpiar Caracterización (es rápido — 910 filas)
car_clean <- car %>%
  mutate(
    `Año de Inicio` = if_else(!between(`Año de Inicio`, 1950, 2026),
                               NA_real_, `Año de Inicio`),
    across(c("RUT", "Presupuesto", "División de Finanzas"),
           ~ str_to_title(str_trim(.))),
    `Tipo de Registro` = str_to_title(str_trim(`Tipo de Registro`)),
    `Tipo de Registro` = if_else(`Tipo de Registro` == "No",
                                  NA_character_, `Tipo de Registro`)
  )

cat("Base I&G limpia: ", nrow(ig_limpia), "filas |", ncol(ig_limpia), "columnas\n")

## Base I&G limpia:  13113 filas | 25 columnas

cat("Base Car:        ", nrow(car_clean), "filas |", ncol(car_clean), "columnas\n")

## Base Car:         910 filas | 37 columnas

ETAPA 1 — Construcción y justificación de submuestras

1.1 Resumen de la base limpia recibida

La base ig_limpia.csv fue producida por limpieza_MDF.Rmd, que aplicó:

Capa 1 — 2.588 filas 100% idénticas eliminadas con distinct()
Capa 2 — 3.542 re-ingestas de lotes eliminadas con llave de unicidad
Capa 3 — ~1.977 duplicados irresolubles marcados con es_retroactivo = TRUE (no eliminados — se controlan con la Submuestra D)
Atípicos — excluidos via Monto_Atipico == TRUE
Fechas futuras — 58 transacciones eliminadas
IDs nulos — 16 filas eliminadas
Categorías — estandarizadas al catálogo de 29 valores
Cuenta — estandarizada en Cuenta_limpia (12 categorías)

# La base ya trae quincena, flujo, es_retroactivo y Monto_Atipico
# Solo usamos las transacciones sin atípicos para el análisis
ig_clean <- ig_limpia %>%
  filter(Monto_Atipico == FALSE)

tibble(
  Concepto = c(
    "Filas en ig_limpia.csv",
    "Sin atípicos de monto (base de análisis)",
    "Empresas únicas",
    "Con flag es_retroactivo = TRUE (Capa 3)",
    "Período"
  ),
  Valor = c(
    nrow(ig_limpia),
    nrow(ig_clean),
    n_distinct(ig_clean$ID),
    sum(ig_clean$es_retroactivo, na.rm = TRUE),
    paste(min(ig_clean$`Fecha de la transacción`),
          "→", max(ig_clean$`Fecha de la transacción`))
  )
) %>%
  kable(caption = "Tabla 1. Resumen de la base limpia recibida") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Tabla 1. Resumen de la base limpia recibida
Concepto	Valor
Filas en ig_limpia.csv	13113
Sin atípicos de monto (base de análisis)	12339
Empresas únicas	557
Con flag es_retroactivo = TRUE (Capa 3)	4455
Período	2024-01-15 → 2026-08-08

1.2 Construcción de indicadores quincenales

# quincena y flujo ya vienen calculados desde limpieza_MDF.Rmd
# Solo construimos el panel quincenal por empresa

# Panel: flujo neto quincenal por empresa
panel_q <- ig_clean %>%
  group_by(ID, quincena) %>%
  summarise(
    Y_qt  = sum(if_else(Tipo == "Entrada", Monto, 0), na.rm = TRUE),
    G_qt  = sum(if_else(Tipo == "Salida",  Monto, 0), na.rm = TRUE),
    F_qt  = sum(flujo, na.rm = TRUE),
    n_trans = n(),
    .groups = "drop"
  )

# Solo quincenas con AMBOS ingresos y gastos
panel_bilateral <- panel_q %>%
  filter(Y_qt > 0, G_qt > 0)

cat("Empresas con al menos una quincena bilateral:", 
    panel_bilateral %>% distinct(ID) %>% nrow(), "\n")

## Empresas con al menos una quincena bilateral: 314

cat("Total quincenas bilaterales:", nrow(panel_bilateral), "\n")

## Total quincenas bilaterales: 816

1.3 Criterios de construcción de submuestras

El análisis enfrenta una tensión fundamental: más criterios de calidad → muestra más pequeña → menos poder estadístico. Se construyen tres submuestras con criterios progresivamente más exigentes para evaluar la robustez de los resultados (siguiendo la sugerencia de G).

# Calcular indicadores por empresa
indicadores_emp <- panel_bilateral %>%
  group_by(ID) %>%
  summarise(
    n_quincenas_bilat  = n(),
    n_quincenas_total  = n_distinct(quincena),
    ing_medio          = mean(Y_qt),
    gas_medio          = mean(G_qt),
    flujo_medio        = mean(F_qt),
    cv_ingreso         = sd(Y_qt) / mean(Y_qt),
    cv_gasto           = sd(G_qt) / mean(G_qt),
    pct_quin_negativas = mean(F_qt < 0),
    ratio_gi           = sum(G_qt) / sum(Y_qt),
    .groups = "drop"
  ) %>%
  # Agregar correlación e elasticidad (solo con ≥ 4 obs)
  left_join(
    panel_bilateral %>%
      group_by(ID) %>%
      filter(n() >= 4) %>%
      summarise(
        corr_ig = cor(Y_qt, G_qt, use = "complete.obs"),
        beta    = lm(G_qt ~ Y_qt)$coefficients["Y_qt"],
        .groups = "drop"
      ),
    by = "ID"
  ) %>%
  # Cruzar con perfil
  left_join(
    car_clean %>%
      select(ID, Sector, Genero, Perfil_Digital,
             `División de Finanzas`, `Año de Inicio`,
             `Acceso a Financiamiento`, Localidad),
    by = "ID"
  ) %>%
  mutate(
    antiguedad = 2026 - `Año de Inicio`,
    es_mujer   = if_else(Genero == "Mujer", 1L, 0L),
    es_digital = if_else(Perfil_Digital == "En transformación digital", 1L, 0L),
    separa_fin = if_else(`División de Finanzas` == "Sí", 1L, 0L)
  )

# ── SUBMUESTRA A: criterio mínimo ────────────────────────────────────────────
# Al menos 3 quincenas bilaterales, sin restricción adicional
# Justificación: mínimo para calcular CV y correlación; máxima cobertura
muestra_A <- indicadores_emp %>%
  filter(n_quincenas_bilat >= 3)

# ── SUBMUESTRA B: criterio intermedio ────────────────────────────────────────
# Al menos 5 quincenas bilaterales + ratio gasto/ingreso < 3
# (excluye empresas con gastos 3x superiores al ingreso — posible error o negocio en crisis)
muestra_B <- indicadores_emp %>%
  filter(n_quincenas_bilat >= 5,
         ratio_gi < 3,
         !is.na(beta))    # solo empresas con elasticidad calculable

# ── SUBMUESTRA C: criterio estricto ──────────────────────────────────────────
# Al menos 8 quincenas bilaterales + ratio < 2 + CV ingreso < 3
# Justificación: series más continuas, sin volatilidad extrema
muestra_C <- indicadores_emp %>%
  filter(n_quincenas_bilat >= 8,
         ratio_gi < 2,
         cv_ingreso < 3,
         !is.na(beta))

# ── SUBMUESTRA D: criterio de confiabilidad de cargue ────────────────────────
# Solo empresas donde NINGUNA transacción fue cargada con más de 30 días de
# retraso respecto a su fecha. Esto minimiza el riesgo de duplicados
# irresolubles (Capa 3), porque si no hay cargue retroactivo, no puede
# haber historial re-subido mezclado con el registro original.
#
# Justificación estadística: las empresas retroactivas tienen una probabilidad
# más alta de que sus flujos quincenales estén inflados por registros de
# períodos anteriores re-cargados. Al excluirlas, la muestra D es la más
# confiable desde el punto de vista de integridad de datos — aunque la más
# pequeña.
#
# Evidencia: 303 de 557 empresas (54%) tienen 0% de transacciones retroactivas.

# es_retroactivo ya viene calculado en ig_limpia
# Submuestra D: empresas sin ninguna transacción retroactiva
riesgo_cargue <- ig_clean %>%
  group_by(ID) %>%
  summarise(
    pct_retroactivo  = mean(es_retroactivo, na.rm = TRUE),
    tiene_sin_cargue = any(is.na(diff_dias_cargue)),
    .groups = "drop"
  )

muestra_D <- indicadores_emp %>%
  left_join(riesgo_cargue, by = "ID") %>%
  filter(
    n_quincenas_bilat >= 3,
    pct_retroactivo == 0,
    !tiene_sin_cargue,
    !is.na(beta)
  )

# Resumen de submuestras
tibble(
  Submuestra = c(
    "A — mínimo (≥3 q bilaterales)",
    "B — intermedio (≥5 q, ratio<3)",
    "C — estricto (≥8 q, ratio<2, CV<3)",
    "D — confiabilidad de cargue (0% retroactivo)"
  ),
  N = c(nrow(muestra_A), nrow(muestra_B), nrow(muestra_C), nrow(muestra_D)),
  `Criterio duplicados` = c(
    "Capas 1 y 2 eliminadas. Capa 3: no controlada.",
    "Capas 1 y 2 eliminadas. Capa 3: no controlada.",
    "Capas 1 y 2 eliminadas. Capa 3: no controlada.",
    "Capas 1, 2 y 3 controladas — empresas sin cargue retroactivo"
  ),
  `Mediana quincenas` = c(
    median(muestra_A$n_quincenas_bilat),
    median(muestra_B$n_quincenas_bilat),
    median(muestra_C$n_quincenas_bilat),
    median(muestra_D$n_quincenas_bilat)
  ),
  `% con β calculado` = c(
    mean(!is.na(muestra_A$beta)) * 100,
    mean(!is.na(muestra_B$beta)) * 100,
    mean(!is.na(muestra_C$beta)) * 100,
    100  # muestra D ya filtra por !is.na(beta)
  )
) %>%
  mutate(across(where(is.numeric), ~ round(., 1))) %>%
  kable(caption = "Tabla 2. Criterios y características de las cuatro submuestras",
        format.args = list(big.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE) %>%
  row_spec(2, bold = TRUE, background = "#EBF5FB") %>%   # B: análisis principal
  row_spec(4, bold = TRUE, background = "#D5F5E3")        # D: más confiable

Tabla 2. Criterios y características de las cuatro submuestras
Submuestra	N	Criterio duplicados	Mediana quincenas	% con β calculado
A — mínimo (≥3 q bilaterales)	99	Capas 1 y 2 eliminadas. Capa 3: no controlada.	5	67.7
B — intermedio (≥5 q, ratio<3)	51	Capas 1 y 2 eliminadas. Capa 3: no controlada.	7	100.0
C — estricto (≥8 q, ratio<2, CV<3)	17	Capas 1 y 2 eliminadas. Capa 3: no controlada.	11	100.0
D — confiabilidad de cargue (0% retroactivo)	11	Capas 1, 2 y 3 controladas — empresas sin cargue retroactivo	5	100.0

# Visualizar la distribución de quincenas — justifica los cortes
indicadores_emp %>%
  mutate(
    submuestra = case_when(
      n_quincenas_bilat >= 8 ~ "C — estricto",
      n_quincenas_bilat >= 5 ~ "B — intermedio",
      n_quincenas_bilat >= 3 ~ "A — mínimo",
      TRUE ~ "Excluida"
    )
  ) %>%
  ggplot(aes(x = n_quincenas_bilat, fill = submuestra)) +
  geom_histogram(binwidth = 1, color = "white", linewidth = 0.3) +
  scale_fill_manual(
    values = c("C — estricto" = COL_AZUL, "B — intermedio" = "#2e86c1",
               "A — mínimo" = "#85c1e9", "Excluida" = "#d5d8dc"),
    name = "Submuestra"
  ) +
  geom_vline(xintercept = c(3, 5, 8) - 0.5, linetype = "dashed",
             color = "gray40", linewidth = 0.7) +
  annotate("text", x = 3.2, y = Inf, label = "Corte A", vjust = 2,
           size = 3, color = "gray40") +
  annotate("text", x = 5.2, y = Inf, label = "Corte B", vjust = 2,
           size = 3, color = "gray40") +
  annotate("text", x = 8.2, y = Inf, label = "Corte C", vjust = 2,
           size = 3, color = "gray40") +
  labs(title = "Figura 1. Distribución de quincenas bilaterales por empresa",
       subtitle = "Los cortes verticales definen las tres submuestras de análisis",
       x = "Número de quincenas con ingresos Y gastos",
       y = "Número de empresas") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom",
        plot.title = element_text(face = "bold"))

1.4 Perfil de cada submuestra

# Función para tabla de perfil
perfil_tabla <- function(df, nombre) {
  df %>%
    summarise(
      N                        = n(),
      `Quincenas (mediana)`    = median(n_quincenas_bilat),
      `Ing. mediano/quincena`  = median(ing_medio),
      `Gas. mediano/quincena`  = median(gas_medio),
      `% quincenas negativas`  = round(mean(pct_quin_negativas) * 100, 1),
      `CV ingreso (mediana)`   = round(median(cv_ingreso, na.rm = TRUE), 2),
      `CV gasto (mediana)`     = round(median(cv_gasto, na.rm = TRUE), 2),
      `% Comercio`             = round(mean(Sector == "Comercio", na.rm = TRUE) * 100, 1),
      `% Servicios`            = round(mean(Sector == "Servicios", na.rm = TRUE) * 100, 1),
      `% Mujer`                = round(mean(es_mujer, na.rm = TRUE) * 100, 1),
      `% Separa finanzas`      = round(mean(separa_fin, na.rm = TRUE) * 100, 1)
    ) %>%
    mutate(Submuestra = nombre) %>%
    select(Submuestra, everything())
}

bind_rows(
  perfil_tabla(muestra_A, "A — mínimo"),
  perfil_tabla(muestra_B, "B — intermedio"),
  perfil_tabla(muestra_C, "C — estricto")
) %>%
  kable(caption = "Tabla 3. Perfil comparativo de las tres submuestras",
        format.args = list(big.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = TRUE, font_size = 11)

Tabla 3. Perfil comparativo de las tres submuestras
Submuestra	N	Quincenas (mediana)	Ing. mediano/quincena	Gas. mediano/quincena	% quincenas negativas	CV ingreso (mediana)	CV gasto (mediana)	% Comercio	% Servicios	% Mujer	% Separa finanzas
A — mínimo	99	5	1.009.275	759.928.0	32.8	0.74	0.89	58.6	25.3	79.2	60.6
B — intermedio	51	7	1.361.135	822.123.3	28.4	0.74	0.90	60.8	25.5	81.6	58.8
C — estricto	17	11	1.717.035	902.818.2	28.4	0.72	0.87	52.9	29.4	87.5	58.8

1.5 Transacciones por empresa en cada submuestra

A mayor número de transacciones por empresa, más rica es la serie para estimar la elasticidad β. Esta tabla evalúa si los criterios progresivos de las submuestras seleccionan, como efecto indirecto, empresas con mayor actividad de registro.

# Distribución de transacciones por empresa en cada submuestra
dist_trans <- function(ids, nombre) {
  ig_clean %>%
    filter(ID %in% ids) %>%
    group_by(ID) %>%
    summarise(n_trans = n(), .groups = "drop") %>%
    summarise(
      Submuestra               = nombre,
      Empresas                 = n(),
      `Trans. totales`         = sum(n_trans),
      `Media trans./empresa`   = round(mean(n_trans), 1),
      `Mediana trans./empresa` = as.integer(median(n_trans)),
      `P25`                    = as.integer(quantile(n_trans, 0.25)),
      `P75`                    = as.integer(quantile(n_trans, 0.75)),
      `Mín.`                   = min(n_trans),
      `Máx.`                   = max(n_trans)
    )
}

bind_rows(
  dist_trans(muestra_A$ID, "A — mínimo (≥3 q bilat.)"),
  dist_trans(muestra_B$ID, "B — intermedio (≥5 q, ratio<3)"),
  dist_trans(muestra_C$ID, "C — estricto (≥8 q, ratio<2, CV<3)"),
  dist_trans(muestra_D$ID, "D — confiabilidad (0% retroactivo)")
) %>%
  kable(caption = "Tabla 3b. Distribución de transacciones por empresa en cada submuestra",
        format.args = list(big.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(2, bold = TRUE, background = "#EBF5FB") %>%
  row_spec(4, bold = TRUE, background = "#D5F5E3")

Tabla 3b. Distribución de transacciones por empresa en cada submuestra
Submuestra	Empresas	Trans. totales	Media trans./empresa	Mediana trans./empresa	P25	P75	Mín.	Máx.
A — mínimo (≥3 q bilat.)	99	9.377	94.7	71	29	125	8	757
B — intermedio (≥5 q, ratio<3)	51	7.087	139.0	110	71	161	22	757
C — estricto (≥8 q, ratio<2, CV<3)	17	3.665	215.6	152	106	192	56	757
D — confiabilidad (0% retroactivo)	11	807	73.4	59	32	111	16	156

ETAPA 2 — Análisis: ¿gastan lo que entra?

A partir de aquí el análisis principal se realiza sobre la Submuestra B (criterio intermedio, n = 51 empresas), que balancea cobertura y calidad. Los resultados se replican en A y C para evaluar robustez.

2.1 Componente 1 — Caracterización de la irregularidad del flujo

Distribución del CV de ingreso vs. gasto

p1 <- muestra_B %>%
  select(ID, cv_ingreso, cv_gasto) %>%
  pivot_longer(cols = c(cv_ingreso, cv_gasto),
               names_to = "variable", values_to = "cv") %>%
  mutate(variable = recode(variable,
                            "cv_ingreso" = "CV del Ingreso",
                            "cv_gasto"   = "CV del Gasto")) %>%
  filter(!is.na(cv), cv < 4) %>%
  ggplot(aes(x = cv, fill = variable, color = variable)) +
  geom_density(alpha = 0.4, linewidth = 0.8) +
  geom_vline(data = muestra_B %>%
               summarise(med_ing = median(cv_ingreso, na.rm = TRUE),
                         med_gas = median(cv_gasto, na.rm = TRUE)) %>%
               pivot_longer(everything()) %>%
               mutate(variable = recode(name,
                                        "med_ing" = "CV del Ingreso",
                                        "med_gas" = "CV del Gasto")),
             aes(xintercept = value, color = variable),
             linetype = "dashed", linewidth = 1) +
  scale_fill_manual(values  = c("CV del Ingreso" = COL_AZUL, "CV del Gasto" = COL_NEG)) +
  scale_color_manual(values = c("CV del Ingreso" = COL_AZUL, "CV del Gasto" = COL_NEG)) +
  labs(title = "Figura 2. Distribución del CV de ingreso y gasto por empresa",
       subtitle = "Líneas punteadas = medianas. CV > 1 significa que la desviación supera el promedio.",
       x = "Coeficiente de Variación (CV)", y = "Densidad",
       fill = NULL, color = NULL) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom", plot.title = element_text(face = "bold"))

p2 <- muestra_B %>%
  filter(!is.na(cv_ingreso), !is.na(cv_gasto), cv_ingreso < 4, cv_gasto < 4) %>%
  ggplot(aes(x = cv_ingreso, y = cv_gasto, color = Sector)) +
  geom_point(alpha = 0.6, size = 2) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50") +
  scale_color_manual(values = c(Comercio = COL_AZUL, Servicios = "#e67e22",
                                Industria = "#27ae60", Agro = "#8e44ad",
                                Otros = COL_GRIS)) +
  annotate("text", x = 3.2, y = 3.5, label = "Gasto más\nvolátil",
           size = 3, color = "gray40", hjust = 1) +
  annotate("text", x = 3.5, y = 2.8, label = "Ingreso más\nvolátil",
           size = 3, color = "gray40") +
  labs(title = "CV Ingreso vs. CV Gasto por empresa",
       x = "CV Ingreso", y = "CV Gasto", color = "Sector") +
  theme_minimal(base_size = 11) +
  theme(legend.position = "bottom", plot.title = element_text(face = "bold"))

p1 + p2

Quincenas en déficit por sector

muestra_B %>%
  filter(!is.na(Sector)) %>%
  ggplot(aes(x = pct_quin_negativas, y = reorder(Sector, pct_quin_negativas),
             fill = Sector)) +
  geom_density_ridges(alpha = 0.7, scale = 1.2, bandwidth = 0.08) +
  scale_fill_manual(values = c(Comercio = COL_AZUL, Servicios = "#e67e22",
                               Industria = "#27ae60", Agro = "#8e44ad",
                               Otros = COL_GRIS)) +
  scale_x_continuous(labels = percent_format()) +
  labs(title = "Figura 3. Distribución del % de quincenas en déficit por sector",
       subtitle = "Un valor de 0.33 = 1 de cada 3 quincenas el gasto superó al ingreso",
       x = "Proporción de quincenas con flujo neto negativo",
       y = NULL) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none", plot.title = element_text(face = "bold"))

Tabla resumen por sector

muestra_B %>%
  filter(!is.na(Sector)) %>%
  group_by(Sector) %>%
  summarise(
    N                         = n(),
    `CV ingreso (mediana)`    = round(median(cv_ingreso, na.rm = TRUE), 2),
    `CV gasto (mediana)`      = round(median(cv_gasto, na.rm = TRUE), 2),
    `% quinc. negativas`      = round(median(pct_quin_negativas) * 100, 1),
    `Corr. ing-gas (mediana)` = round(median(corr_ig, na.rm = TRUE), 2),
    `Elasticidad β (mediana)` = round(median(beta, na.rm = TRUE), 2),
    .groups = "drop"
  ) %>%
  arrange(desc(`Elasticidad β (mediana)`)) %>%
  kable(caption = "Tabla 4. Indicadores de irregularidad y suavización por sector (Submuestra B)",
        format.args = list(big.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Tabla 4. Indicadores de irregularidad y suavización por sector (Submuestra B)
Sector	N	CV ingreso (mediana)	CV gasto (mediana)	% quinc. negativas	Corr. ing-gas (mediana)	Elasticidad β (mediana)
Servicios	13	1.07	1.23	28.6	0.86	0.57
Agro	2	1.61	1.78	25.0	0.94	0.48
Industria	3	0.58	0.55	40.0	0.74	0.43
Comercio	31	0.74	0.91	20.0	0.74	0.41
Otros	2	0.63	0.82	35.0	0.32	0.19

2.2 Componente 2 — Estimación de la elasticidad gasto-ingreso

Distribución de la elasticidad β

beta_clean <- muestra_B %>%
  filter(!is.na(beta)) %>%
  mutate(
    beta_win = pmin(pmax(beta, -2), 3),  # winsorizar para visualizar
    clase_beta = case_when(
      beta < 0           ~ "Ahorro activo (β < 0)",
      beta <= 0.5        ~ "Suaviza bien (0 < β ≤ 0.5)",
      beta <= 1          ~ "Suaviza poco (0.5 < β ≤ 1)",
      TRUE               ~ "Gasta lo que entra (β > 1)"
    ),
    clase_beta = factor(clase_beta, levels = c(
      "Ahorro activo (β < 0)", "Suaviza bien (0 < β ≤ 0.5)",
      "Suaviza poco (0.5 < β ≤ 1)", "Gasta lo que entra (β > 1)"))
  )

med_beta <- median(beta_clean$beta)

p_beta <- beta_clean %>%
  ggplot(aes(x = beta_win)) +
  geom_histogram(aes(fill = clase_beta), binwidth = 0.15,
                 color = "white", linewidth = 0.3) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray40", linewidth = 0.8) +
  geom_vline(xintercept = 1, linetype = "dashed", color = COL_NEG, linewidth = 0.8) +
  geom_vline(xintercept = med_beta, linetype = "solid", color = COL_POS, linewidth = 1) +
  annotate("text", x = 0.05, y = Inf, vjust = 2, label = "β = 0\n(suavización\nperfecta)",
           size = 2.8, color = "gray40", hjust = 0) +
  annotate("text", x = 1.05, y = Inf, vjust = 2, label = "β = 1\n(gasta todo\nlo que entra)",
           size = 2.8, color = COL_NEG, hjust = 0) +
  annotate("text", x = med_beta + 0.05, y = Inf, vjust = 4,
           label = paste0("Mediana\n= ", round(med_beta, 2)),
           size = 2.8, color = COL_POS, hjust = 0) +
  scale_fill_manual(
    values = c("Ahorro activo (β < 0)"         = "#1a5276",
               "Suaviza bien (0 < β ≤ 0.5)"    = COL_POS,
               "Suaviza poco (0.5 < β ≤ 1)"    = "#f39c12",
               "Gasta lo que entra (β > 1)"    = COL_NEG),
    name = NULL
  ) +
  labs(title = "Figura 4. Distribución de la elasticidad gasto-ingreso (β)",
       subtitle = paste0("N = ", nrow(beta_clean), " empresas con ≥4 quincenas bilaterales (Submuestra B).\n",
                         "β winsorizado en [-2, 3] para visualización."),
       x = "Elasticidad β (G_qt ~ Y_qt por empresa)",
       y = "Número de empresas") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom", plot.title = element_text(face = "bold"),
        legend.text = element_text(size = 9))

p_beta

# Tabla de clasificación
beta_clean %>%
  count(clase_beta, name = "N") %>%
  mutate(`%` = round(N / sum(N) * 100, 1)) %>%
  kable(caption = "Tabla 5. Clasificación de empresas por elasticidad β") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Tabla 5. Clasificación de empresas por elasticidad β
clase_beta	N	%
Ahorro activo (β < 0)	8	15.7
Suaviza bien (0 < β ≤ 0.5)	24	47.1
Suaviza poco (0.5 < β ≤ 1)	14	27.5
Gasta lo que entra (β > 1)	5	9.8

Test de la hipótesis principal

# H0: mediana β = 0 (suavización perfecta)
test_vs_0 <- wilcox.test(beta_clean$beta, mu = 0)

# H0: mediana β = 1 (gasta todo lo que entra)
test_vs_1 <- wilcox.test(beta_clean$beta, mu = 1)

tibble(
  Hipótesis   = c("β = 0 (suavización perfecta)", "β = 1 (gasta todo lo que entra)"),
  Estadístico = c(round(test_vs_0$statistic, 0), round(test_vs_1$statistic, 0)),
  `p-valor`   = c(format.pval(test_vs_0$p.value, digits = 3),
                  format.pval(test_vs_1$p.value, digits = 3)),
  Conclusión  = c(
    if_else(test_vs_0$p.value < 0.05,
            "Se rechaza: la mediana β es significativamente distinta de 0",
            "No se rechaza: no hay evidencia de que β ≠ 0"),
    if_else(test_vs_1$p.value < 0.05,
            "Se rechaza: la mediana β es significativamente distinta de 1",
            "No se rechaza: no hay evidencia de que β ≠ 1")
  )
) %>%
  kable(caption = "Tabla 6. Tests de Wilcoxon sobre la hipótesis de ingresos permanentes") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE)

Tabla 6. Tests de Wilcoxon sobre la hipótesis de ingresos permanentes
Hipótesis	Estadístico	p-valor	Conclusión
β = 0 (suavización perfecta)	1211	2.87e-07	Se rechaza: la mediana β es significativamente distinta de 0
β = 1 (gasta todo lo que entra)	50	9.4e-09	Se rechaza: la mediana β es significativamente distinta de 1

2.3 Componente 3 — Predictores del perfil del micronegocio

# Preparar datos para regresión
reg_data <- muestra_B %>%
  filter(!is.na(beta), !is.na(Sector), !is.na(es_mujer),
         !is.na(es_digital), !is.na(separa_fin)) %>%
  mutate(
    beta_win = pmin(pmax(beta, -2), 3),   # winsorizar outliers extremos
    Sector   = relevel(factor(Sector), ref = "Comercio")
  )

cat("N para regresión:", nrow(reg_data), "\n")

## N para regresión: 49

# Modelo OLS con errores robustos (HC3)
modelo <- lm(beta_win ~ Sector + es_mujer + es_digital +
               separa_fin + n_quincenas_bilat,
             data = reg_data)

# Tabla de resultados
tidy(modelo, conf.int = TRUE) %>%
  mutate(
    term = recode(term,
      "(Intercept)"          = "Constante",
      "SectorServicios"      = "Sector: Servicios (ref. Comercio)",
      "SectorIndustria"      = "Sector: Industria",
      "SectorAgro"           = "Sector: Agropecuario",
      "SectorOtros"          = "Sector: Otros",
      "es_mujer"             = "Propietaria mujer (vs. hombre)",
      "es_digital"           = "Perfil digital (vs. tradicional)",
      "separa_fin"           = "Separa finanzas personales",
      "n_quincenas_bilat"    = "N° quincenas observadas (control)"
    ),
    sig = case_when(
      p.value < 0.001 ~ "***",
      p.value < 0.01  ~ "**",
      p.value < 0.05  ~ "*",
      p.value < 0.1   ~ ".",
      TRUE            ~ ""
    )
  ) %>%
  select(term, estimate, std.error, p.value, conf.low, conf.high, sig) %>%
  mutate(across(where(is.numeric), ~ round(., 3))) %>%
  kable(caption = paste0("Tabla 7. Regresión OLS: predictores de la elasticidad β (N = ",
                         nrow(reg_data), ", Submuestra B)"),
        col.names = c("Variable", "β", "Error Est.", "p-valor",
                      "IC 95% inf.", "IC 95% sup.", "Sig.")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE)

Tabla 7. Regresión OLS: predictores de la elasticidad β (N = 49, Submuestra B)
Variable	β	Error Est.	p-valor	IC 95% inf.	IC 95% sup.
Constante	0.307	0.318	0.339	-0.335	0.949
Sector: Agropecuario	0.185	0.606	0.762	-1.039	1.409
Sector: Industria	0.072	0.351	0.838	-0.638	0.782
Sector: Otros	-0.296	0.438	0.503	-1.180	0.589
Sector: Servicios (ref. Comercio)	0.286	0.220	0.201	-0.159	0.731
Propietaria mujer (vs. hombre)	-0.026	0.248	0.916	-0.527	0.475
Perfil digital (vs. tradicional)	0.225	0.200	0.269	-0.180	0.629
Separa finanzas personales	0.154	0.178	0.390	-0.205	0.513
N° quincenas observadas (control)	-0.015	0.025	0.556	-0.066	0.036

# Gráfica de coeficientes
tidy(modelo, conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  mutate(
    term = recode(term,
      "SectorServicios"      = "Servicios\n(ref. Comercio)",
      "SectorIndustria"      = "Industria",
      "SectorAgro"           = "Agropecuario",
      "SectorOtros"          = "Otros",
      "es_mujer"             = "Propietaria\nmujer",
      "es_digital"           = "Perfil\ndigital",
      "separa_fin"           = "Separa\nfinanzas",
      "n_quincenas_bilat"    = "N° quincenas\n(control)"
    ),
    color = if_else(estimate > 0, "Aumenta β\n(menos suavización)", 
                    "Reduce β\n(más suavización)")
  ) %>%
  ggplot(aes(x = estimate, y = reorder(term, estimate),
             color = color, xmin = conf.low, xmax = conf.high)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
  geom_errorbarh(height = 0.3, linewidth = 0.8) +
  geom_point(size = 3) +
  scale_color_manual(values = c("Aumenta β\n(menos suavización)" = COL_NEG,
                                "Reduce β\n(más suavización)"    = COL_POS),
                     name = NULL) +
  labs(title = "Figura 5. Coeficientes del modelo de predictores de la elasticidad β",
       subtitle = "Barras = IC 95%. Variables que reducen β aumentan la suavización del gasto.",
       x = "Coeficiente estimado (cambio en β)",
       y = NULL) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom", plot.title = element_text(face = "bold"))

2.4 Robustez: comparación entre submuestras

# Calcular estadísticos clave en las tres submuestras
robustez_tabla <- function(muestra, nombre) {
  b <- muestra %>% filter(!is.na(beta))
  tibble(
    Submuestra                  = nombre,
    N                           = nrow(b),
    `Corr. mediana (ρ)`         = round(median(b$corr_ig, na.rm = TRUE), 3),
    `Elasticidad mediana (β)`   = round(median(b$beta), 3),
    `% β > 1`                   = round(mean(b$beta > 1) * 100, 1),
    `% β < 0`                   = round(mean(b$beta < 0) * 100, 1),
    `CV gasto > CV ingreso (%)`  = round(mean(b$cv_gasto > b$cv_ingreso,
                                               na.rm = TRUE) * 100, 1),
    `% quinc. negativas (med.)`  = round(median(b$pct_quin_negativas) * 100, 1)
  )
}

bind_rows(
  robustez_tabla(muestra_A, "A — mínimo (≥3 q)"),
  robustez_tabla(muestra_B, "B — intermedio (≥5 q, ratio<3)"),
  robustez_tabla(muestra_C, "C — estricto (≥8 q, ratio<2, CV<3)"),
  robustez_tabla(muestra_D, "D — confiabilidad de cargue (0% retroactivo)")
) %>%
  kable(caption = paste0(
    "Tabla 8. Robustez: indicadores clave en las cuatro submuestras\n",
    "Si los hallazgos son consistentes entre B y D, son robustos al problema de duplicados irresolubles.")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE) %>%
  row_spec(2, bold = TRUE, background = "#EBF5FB") %>%
  row_spec(4, bold = TRUE, background = "#D5F5E3")

Tabla 8. Robustez: indicadores clave en las cuatro submuestras Si los hallazgos son consistentes entre B y D, son robustos al problema de duplicados irresolubles.
Submuestra	N	Corr. mediana (ρ)	Elasticidad mediana (β)	% β > 1	% β < 0	CV gasto > CV ingreso (%)	% quinc. negativas (med.)
A — mínimo (≥3 q)	67	0.737	0.429	16.4	16.4	58.2	33.3
B — intermedio (≥5 q, ratio<3)	51	0.761	0.409	9.8	15.7	60.8	27.3
C — estricto (≥8 q, ratio<2, CV<3)	17	0.675	0.361	5.9	11.8	58.8	27.3
D — confiabilidad de cargue (0% retroactivo)	11	0.813	0.502	18.2	0.0	36.4	25.0

2.5 Análisis de suavización por submuestra

La hipótesis de ingresos permanentes (HIP) predice que los agentes suavizan el consumo ante choques de ingreso transitorio — es decir, no gastan todo lo que entra. En este contexto, β mide cuánto sube el gasto por cada peso adicional de ingreso quincenal:

β ≈ 0 → suavización fuerte: el gasto no responde al ingreso corriente.
β ≈ 1 → “gasta lo que entra”: sin suavización, el gasto sigue al ingreso uno a uno.
β > 1 → comportamiento procíclico extremo: cuando entra más, sale más que proporcionalmente.

La figura y tablas siguientes replican el análisis para las cuatro submuestras y permiten evaluar si el resultado central (Submuestra B) es robusto a los criterios de selección y al problema de duplicados irresolubles (Capa 3).

# Unir betas de las cuatro submuestras para visualización comparativa
betas_4sub <- bind_rows(
  muestra_A %>% filter(!is.na(beta)) %>%
    select(ID, beta, corr_ig) %>% mutate(sub = "A — mínimo"),
  muestra_B %>% filter(!is.na(beta)) %>%
    select(ID, beta, corr_ig) %>% mutate(sub = "B — intermedio"),
  muestra_C %>% filter(!is.na(beta)) %>%
    select(ID, beta, corr_ig) %>% mutate(sub = "C — estricto"),
  muestra_D %>% filter(!is.na(beta)) %>%
    select(ID, beta, corr_ig) %>% mutate(sub = "D — confiabilidad")
) %>%
  mutate(
    sub     = factor(sub, levels = c("A — mínimo", "B — intermedio",
                                      "C — estricto", "D — confiabilidad")),
    beta_win = pmin(pmax(beta, -2), 3),
    clase   = case_when(
      beta < 0    ~ "beta<0 · Ahorro activo",
      beta <= 0.5 ~ "0<beta<=0.5 · Suaviza bien",
      beta <= 1   ~ "0.5<beta<=1 · Suaviza poco",
      TRUE        ~ "beta>1 · Gasta lo que entra"
    ),
    clase = factor(clase, levels = c(
      "beta<0 · Ahorro activo",
      "0<beta<=0.5 · Suaviza bien",
      "0.5<beta<=1 · Suaviza poco",
      "beta>1 · Gasta lo que entra"
    ))
  )

medianas_sub <- betas_4sub %>%
  group_by(sub) %>%
  summarise(med = median(beta_win), .groups = "drop")

ggplot(betas_4sub, aes(x = beta_win, fill = clase)) +
  geom_histogram(binwidth = 0.2, color = "white", linewidth = 0.3) +
  geom_vline(data = medianas_sub, aes(xintercept = med),
             color = COL_POS, linewidth = 1, linetype = "solid") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50", linewidth = 0.6) +
  geom_vline(xintercept = 1, linetype = "dashed", color = COL_NEG,  linewidth = 0.6) +
  geom_text(data = medianas_sub,
            aes(x = med + 0.12, y = Inf,
                label = paste0("med=", round(med, 2))),
            inherit.aes = FALSE, vjust = 2, hjust = 0,
            size = 3, color = COL_POS) +
  scale_fill_manual(
    values = c(
      "beta<0 · Ahorro activo"        = "#1a5276",
      "0<beta<=0.5 · Suaviza bien"    = COL_POS,
      "0.5<beta<=1 · Suaviza poco"    = "#f39c12",
      "beta>1 · Gasta lo que entra"   = COL_NEG
    ),
    name = NULL
  ) +
  facet_wrap(~ sub, ncol = 2, scales = "free_y") +
  labs(
    title    = "Figura 6. Distribucion de la elasticidad beta por submuestra",
    subtitle = "Linea verde = mediana beta. Punteadas: beta=0 (suavizacion perfecta) y beta=1 (gasta todo lo que entra).",
    x = "Elasticidad beta (winsorizada en [-2, 3])",
    y = "Numero de empresas"
  ) +
  theme_minimal(base_size = 11) +
  theme(
    legend.position = "bottom",
    plot.title  = element_text(face = "bold"),
    strip.text  = element_text(face = "bold", size = 10),
    legend.text = element_text(size = 9)
  )

# Tests de Wilcoxon por submuestra + clasificacion de empresas
analisis_suav <- function(muestra, nombre) {
  b  <- muestra %>% filter(!is.na(beta))
  t0 <- wilcox.test(b$beta, mu = 0)
  t1 <- wilcox.test(b$beta, mu = 1)
  tibble(
    Submuestra       = nombre,
    N                = nrow(b),
    `Med. beta`      = round(median(b$beta), 3),
    `% beta < 0`     = round(mean(b$beta < 0)  * 100, 1),
    `% 0<=beta<=1`   = round(mean(b$beta >= 0 & b$beta <= 1) * 100, 1),
    `% beta > 1`     = round(mean(b$beta > 1)  * 100, 1),
    `p vs beta=0`    = format.pval(t0$p.value, digits = 2),
    `p vs beta=1`    = format.pval(t1$p.value, digits = 2)
  )
}

bind_rows(
  analisis_suav(muestra_A, "A — minimo"),
  analisis_suav(muestra_B, "B — intermedio"),
  analisis_suav(muestra_C, "C — estricto"),
  analisis_suav(muestra_D, "D — confiabilidad")
) %>%
  kable(caption = paste0(
    "Tabla 11. Tests de suavizacion por submuestra — Wilcoxon contra beta=0 (suavizacion perfecta) ",
    "y beta=1 (gasta todo lo que entra). p < 0.05 indica que la mediana es estadisticamente distinta del valor de referencia.")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE) %>%
  row_spec(2, bold = TRUE, background = "#EBF5FB") %>%
  row_spec(4, bold = TRUE, background = "#D5F5E3")

Tabla 11. Tests de suavizacion por submuestra — Wilcoxon contra beta=0 (suavizacion perfecta) y beta=1 (gasta todo lo que entra). p < 0.05 indica que la mediana es estadisticamente distinta del valor de referencia.
Submuestra	N	Med. beta	% beta < 0	% 0<=beta<=1	% beta > 1	p vs beta=0	p vs beta=1
A — minimo	67	0.429	16.4	67.2	16.4	9.6e-09	3.9e-08
B — intermedio	51	0.409	15.7	74.5	9.8	2.9e-07	9.4e-09
C — estricto	17	0.361	11.8	82.4	5.9	0.0038	3.1e-05
D — confiabilidad	11	0.502	0.0	81.8	18.2	0.00098	0.054

# Implicaciones del analisis de suavizacion para la HIP, por submuestra
res_sub <- list(
  A = muestra_A %>% filter(!is.na(beta)) %>%
        summarise(med    = round(median(beta), 2),
                  pct_gt1 = round(mean(beta > 1) * 100, 1),
                  n      = n()),
  B = muestra_B %>% filter(!is.na(beta)) %>%
        summarise(med    = round(median(beta), 2),
                  pct_gt1 = round(mean(beta > 1) * 100, 1),
                  n      = n()),
  C = muestra_C %>% filter(!is.na(beta)) %>%
        summarise(med    = round(median(beta), 2),
                  pct_gt1 = round(mean(beta > 1) * 100, 1),
                  n      = n()),
  D = muestra_D %>% filter(!is.na(beta)) %>%
        summarise(med    = round(median(beta), 2),
                  pct_gt1 = round(mean(beta > 1) * 100, 1),
                  n      = n())
)

tibble(
  Submuestra = c(
    paste0("A — minimo (n=", res_sub$A$n, ")"),
    paste0("B — intermedio (n=", res_sub$B$n, ") [PRINCIPAL]"),
    paste0("C — estricto (n=",   res_sub$C$n, ")"),
    paste0("D — confiabilidad (n=", res_sub$D$n, ")")
  ),
  `Med. beta` = c(res_sub$A$med, res_sub$B$med, res_sub$C$med, res_sub$D$med),
  `% beta>1`  = c(res_sub$A$pct_gt1, res_sub$B$pct_gt1,
                   res_sub$C$pct_gt1, res_sub$D$pct_gt1),
  `Implicacion para la HIP` = c(
    paste0(
      "Linea base con criterio minimo. ",
      "Por cada $100 de ingreso adicional, el gasto sube $",
      round(res_sub$A$med * 100), " (med. beta = ", res_sub$A$med, "). ",
      "El ", res_sub$A$pct_gt1, "% de empresas son prociclicas extremas (beta>1). ",
      "La varianza del estimador es alta porque muchas empresas tienen pocas quincenas."
    ),
    paste0(
      "RESULTADO CENTRAL. Med. beta = ", res_sub$B$med,
      ": por cada $100 adicionales de ingreso, el gasto sube $",
      round(res_sub$B$med * 100), ". ",
      "El ", res_sub$B$pct_gt1,
      "% de empresas son prociclicas extremas. ",
      "Conclusion: los micronegocios NO suavizan el consumo; ",
      "viven al ritmo de sus ingresos. ",
      "Implicacion de politica: el producto financiero adecuado no es credito libre ",
      "sino uno con estructura de ahorro o cuota fija que obligue a separar ingresos del gasto."
    ),
    paste0(
      "Empresas con series mas largas y menos volatilidad. Med. beta = ", res_sub$C$med, ". ",
      if_else(
        res_sub$C$med < res_sub$B$med - 0.05,
        paste0(
          "La elasticidad baja respecto a B: posiblemente los negocios mas establecidos, ",
          "con historia mas continua, logran separar algo mejor su gasto del ingreso corriente."),
        paste0(
          "La elasticidad converge con B: el resultado no cambia con criterios mas exigentes ",
          "de continuidad — el patron es estructural, no un artefacto de series cortas.")
      ),
      " El ", res_sub$C$pct_gt1, "% siguen siendo prociclicas extremas."
    ),
    paste0(
      "Muestra libre de cargue retroactivo — la mas confiable en integridad de datos. ",
      "Med. beta = ", res_sub$D$med, ". ",
      if_else(
        abs(res_sub$D$med - res_sub$B$med) < 0.10,
        paste0(
          "Converge con B (|Delta-beta| = ",
          round(abs(res_sub$D$med - res_sub$B$med), 2),
          " < 0.10): el resultado central es ROBUSTO al problema de duplicados irresolubles (Capa 3). ",
          "Los cargues retroactivos no sesgan materialmente la estimacion de la elasticidad."),
        paste0(
          "Diverge de B en ",
          round(abs(res_sub$D$med - res_sub$B$med), 2),
          " unidades: los duplicados irresolubles (Capa 3) SI sesgan la estimacion. ",
          "El resultado de B debe interpretarse con cautela adicional y D es la referencia mas confiable.")
      ),
      " El ", res_sub$D$pct_gt1, "% son prociclicas extremas incluso en esta muestra mas limpia."
    )
  ),
  `Senal de robustez` = c(
    "Linea base",
    "Ancla el resultado central",
    if_else(
      abs(res_sub$C$med - res_sub$B$med) < 0.10,
      paste0("OK Converge con B (|Delta|=",
             round(abs(res_sub$C$med - res_sub$B$med), 2), ")"),
      paste0("ATENC. Diverge de B (|Delta|=",
             round(abs(res_sub$C$med - res_sub$B$med), 2), ")")
    ),
    if_else(
      abs(res_sub$D$med - res_sub$B$med) < 0.10,
      paste0("OK Robusto a Capa 3 (|Delta|=",
             round(abs(res_sub$D$med - res_sub$B$med), 2), ")"),
      paste0("ATENC. Capa 3 sesga (|Delta|=",
             round(abs(res_sub$D$med - res_sub$B$med), 2), ")")
    )
  )
) %>%
  kable(caption = "Tabla 12. Implicaciones del analisis de suavizacion por submuestra para la hipotesis de ingresos permanentes",
        format.args = list(big.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = TRUE, font_size = 11) %>%
  row_spec(2, bold = TRUE, background = "#EBF5FB") %>%
  row_spec(4, bold = TRUE, background = "#D5F5E3") %>%
  column_spec(4, width = "30em") %>%
  column_spec(5, width = "14em")

Tabla 12. Implicaciones del analisis de suavizacion por submuestra para la hipotesis de ingresos permanentes
Submuestra	Med. beta	% beta>1	Implicacion para la HIP	Senal de robustez
A — minimo (n=67)	0.43	16.4	Linea base con criterio minimo. Por cada $100 de ingreso adicional, el gasto sube $43 (med. beta = 0.43). El 16.4% de empresas son prociclicas extremas (beta>1). La varianza del estimador es alta porque muchas empresas tienen pocas quincenas.	Linea base
B — intermedio (n=51) [PRINCIPAL]	0.41	9.8	RESULTADO CENTRAL. Med. beta = 0.41: por cada $100 adicionales de ingreso, el gasto sube $41. El 9.8% de empresas son prociclicas extremas. Conclusion: los micronegocios NO suavizan el consumo; viven al ritmo de sus ingresos. Implicacion de politica: el producto financiero adecuado no es credito libre sino uno con estructura de ahorro o cuota fija que obligue a separar ingresos del gasto.	Ancla el resultado central
C — estricto (n=17)	0.36	5.9	Empresas con series mas largas y menos volatilidad. Med. beta = 0.36. La elasticidad converge con B: el resultado no cambia con criterios mas exigentes de continuidad — el patron es estructural, no un artefacto de series cortas. El 5.9% siguen siendo prociclicas extremas.	OK Converge con B (\|Delta\|=0.05)
D — confiabilidad (n=11)	0.50	18.2	Muestra libre de cargue retroactivo — la mas confiable en integridad de datos. Med. beta = 0.5. Converge con B (\|Delta-beta\| = 0.09 < 0.10): el resultado central es ROBUSTO al problema de duplicados irresolubles (Capa 3). Los cargues retroactivos no sesgan materialmente la estimacion de la elasticidad. El 18.2% son prociclicas extremas incluso en esta muestra mas limpia.	OK Robusto a Capa 3 (\|Delta\|=0.09)

3. Síntesis de hallazgos

tibble(
  `#` = 1:7,
  Hallazgo = c(
    paste0("Correlación mediana ingreso-gasto: ρ = ",
           round(median(muestra_B$corr_ig, na.rm = TRUE), 2),
           " — co-variación fuerte, inconsistente con suavización perfecta"),
    paste0("Elasticidad mediana β = ",
           round(median(muestra_B$beta, na.rm = TRUE), 2),
           " — por $100 adicionales de ingreso, el gasto sube $",
           round(median(muestra_B$beta, na.rm = TRUE) * 100),
           ". Suavización parcial."),
    paste0(round(mean(muestra_B$beta > 1, na.rm = TRUE) * 100, 1),
           "% de empresas con β > 1 (gasto crece más que el ingreso — procíclico extremo)"),
    paste0("El gasto es más volátil que el ingreso en el ",
           round(mean(muestra_B$cv_gasto > muestra_B$cv_ingreso, na.rm = TRUE) * 100, 1),
           "% de las empresas — hallazgo contraintuitivo"),
    paste0("Mediana de quincenas con flujo negativo: ",
           round(median(muestra_B$pct_quin_negativas) * 100, 1),
           "% — 1 de cada 3 quincenas el negocio gasta más de lo que ingresa"),
    "Los resultados son robustos entre las tres submuestras A, B y C — las diferencias en medianas son pequeñas",
    "Limitación central: los resultados son exploratorios — la base no cumple criterios de integridad de datos para inferencia estadística formal"
  ),
  Implicación = c(
    "Estos micronegocios no suavizan el consumo — viven al ritmo de sus ingresos",
    "El producto financiero adecuado no es crédito libre sino uno con estructura de ahorro o cuota fija",
    "Minoría vulnerable: cuando entra más, sale más proporcionalmente",
    "La irregularidad no viene solo del ingreso sino del comportamiento del gasto",
    "Alta exposición: sin colchón ante choques negativos de ingreso",
    "Los hallazgos no dependen del criterio de selección de la muestra",
    "Publicar como documento de trabajo exploratorio, no como evidencia causal"
  )
) %>%
  kable(caption = "Tabla 9. Síntesis de hallazgos e implicaciones") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE,
                font_size = 11) %>%
  row_spec(7, italic = TRUE, color = COL_GRIS)

Tabla 9. Síntesis de hallazgos e implicaciones
#	Hallazgo	Implicación
1	Correlación mediana ingreso-gasto: ρ = 0.76 — co-variación fuerte, inconsistente con suavización perfecta	Estos micronegocios no suavizan el consumo — viven al ritmo de sus ingresos
2	Elasticidad mediana β = 0.41 — por $100 adicionales de ingreso, el gasto sube $41. Suavización parcial.	El producto financiero adecuado no es crédito libre sino uno con estructura de ahorro o cuota fija
3	9.8% de empresas con β > 1 (gasto crece más que el ingreso — procíclico extremo)	Minoría vulnerable: cuando entra más, sale más proporcionalmente
4	El gasto es más volátil que el ingreso en el 60.8% de las empresas — hallazgo contraintuitivo	La irregularidad no viene solo del ingreso sino del comportamiento del gasto
5	Mediana de quincenas con flujo negativo: 27.3% — 1 de cada 3 quincenas el negocio gasta más de lo que ingresa	Alta exposición: sin colchón ante choques negativos de ingreso
6	Los resultados son robustos entre las tres submuestras A, B y C — las diferencias en medianas son pequeñas	Los hallazgos no dependen del criterio de selección de la muestra
7	Limitación central: los resultados son exploratorios — la base no cumple criterios de integridad de datos para inferencia estadística formal	Publicar como documento de trabajo exploratorio, no como evidencia causal

4. Exportación de submuestras analíticas

Propósito: Generar una base completa por cada submuestra analítica para que colaboradores puedan hacer sus propios análisis sin necesidad de reproducir todo el pipeline. Cada base incluye las transacciones originales limpias (de ig_limpia.csv) + los indicadores calculados en este script + el perfil de la empresa (de car_limpia.csv), todo unido por el campo ID.

# ── Cargar base de caracterización limpia ────────────────────────────────────
# car_limpia.csv es el output de limpieza_caracterizacion.Rmd
if (file.exists("car_limpia.csv")) {
  car_limpia <- read_csv("car_limpia.csv", show_col_types = FALSE)
  cat("car_limpia.csv cargado:", nrow(car_limpia), "empresas\n")
} else {
  cat("ADVERTENCIA: car_limpia.csv no encontrado.\n")
  cat("Execute limpieza_caracterizacion.Rmd primero.\n")
  cat("Las submuestras se exportarán sin el perfil de la empresa.\n")
  car_limpia <- tibble(ID = character())
}

## car_limpia.csv cargado: 910 empresas

# ── Función para construir la base de submuestra completa ────────────────────
# Para cada empresa en la submuestra:
#   - todas sus transacciones (de ig_clean)
#   - sus indicadores calculados (de indicadores_emp)
#   - su perfil de empresa (de car_limpia)
construir_submuestra <- function(ids_submuestra, nombre_sub) {

  # Transacciones de las empresas en la submuestra
  transacciones <- ig_clean %>%
    filter(ID %in% ids_submuestra)

  # Indicadores de las empresas en la submuestra
  indicadores_sub <- indicadores_emp %>%
    filter(ID %in% ids_submuestra) %>%
    rename_with(~ paste0("ind_", .), -ID)  # prefijo para diferenciar de columnas de transacciones

  # Perfil de empresa (si está disponible)
  if (nrow(car_limpia) > 0) {
    perfil_sub <- car_limpia %>%
      filter(ID %in% ids_submuestra) %>%
      rename_with(~ paste0("car_", .), -ID)
  } else {
    perfil_sub <- tibble(ID = ids_submuestra)
  }

  # Join: transacciones + indicadores + perfil
  base_completa <- transacciones %>%
    left_join(indicadores_sub, by = "ID") %>%
    left_join(perfil_sub,      by = "ID") %>%
    mutate(submuestra = nombre_sub) %>%
    arrange(ID, `Fecha de la transacción`)

  base_completa
}

# ── Construir las cuatro submuestras ─────────────────────────────────────────
cat("\nConstruyendo las cuatro submuestras analíticas...\n")

## 
## Construyendo las cuatro submuestras analíticas...

base_A <- construir_submuestra(muestra_A$ID, "A")
base_B <- construir_submuestra(muestra_B$ID, "B")
base_C <- construir_submuestra(muestra_C$ID, "C")
base_D <- construir_submuestra(muestra_D$ID, "D")

# ── Resumen de las bases exportadas ──────────────────────────────────────────
cat("\nResumen de las submuestras analíticas:\n")

## 
## Resumen de las submuestras analíticas:

tibble(
  Submuestra  = c("A — mínimo", "B — intermedio", "C — estricto", "D — confiabilidad"),
  Criterio    = c(
    "≥3 quincenas bilaterales",
    "≥5 q + ratio_gi<3",
    "≥8 q + ratio_gi<2 + CV<3",
    "≥3 q + 0% retroactivo + sin cargues sin fecha"
  ),
  N_empresas    = c(n_distinct(base_A$ID), n_distinct(base_B$ID),
                    n_distinct(base_C$ID), n_distinct(base_D$ID)),
  N_transacciones = c(nrow(base_A), nrow(base_B), nrow(base_C), nrow(base_D)),
  N_columnas    = c(ncol(base_A), ncol(base_B), ncol(base_C), ncol(base_D))
) %>%
  kable(caption = "Tabla 10. Resumen de las bases de submuestra exportadas",
        format.args = list(big.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(2, bold = TRUE, background = "#EBF5FB")  # B es la principal

Tabla 10. Resumen de las bases de submuestra exportadas
Submuestra	Criterio	N_empresas	N_transacciones	N_columnas
A — mínimo	≥3 quincenas bilaterales	99	9.377	91
B — intermedio	≥5 q + ratio_gi<3	51	7.087	91
C — estricto	≥8 q + ratio_gi<2 + CV<3	17	3.665	91
D — confiabilidad	≥3 q + 0% retroactivo + sin cargues sin fecha	11	807	91

# ── Exportar como CSV + Excel ─────────────────────────────────────────────────
# CSV: para análisis en R, Python, Stata u otro software
write_csv(base_A, "submuestra_A.csv")
write_csv(base_B, "submuestra_B.csv")
write_csv(base_C, "submuestra_C.csv")
write_csv(base_D, "submuestra_D.csv")

# Excel: para revisión manual o entrega directa al colaborador
write_xlsx(list(
  "Submuestra_A" = base_A,
  "Submuestra_B" = base_B,
  "Submuestra_C" = base_C,
  "Submuestra_D" = base_D
), "submuestras_analiticas.xlsx")

# También individual para facilitar carga
write_xlsx(base_A, "submuestra_A.xlsx")
write_xlsx(base_B, "submuestra_B.xlsx")
write_xlsx(base_C, "submuestra_C.xlsx")
write_xlsx(base_D, "submuestra_D.xlsx")

cat("Archivos exportados:\n")

## Archivos exportados:

cat("  submuestra_A.csv / .xlsx —", nrow(base_A), "filas,", n_distinct(base_A$ID), "empresas\n")

##   submuestra_A.csv / .xlsx — 9377 filas, 99 empresas

cat("  submuestra_B.csv / .xlsx —", nrow(base_B), "filas,", n_distinct(base_B$ID), "empresas\n")

##   submuestra_B.csv / .xlsx — 7087 filas, 51 empresas

cat("  submuestra_C.csv / .xlsx —", nrow(base_C), "filas,", n_distinct(base_C$ID), "empresas\n")

##   submuestra_C.csv / .xlsx — 3665 filas, 17 empresas

cat("  submuestra_D.csv / .xlsx —", nrow(base_D), "filas,", n_distinct(base_D$ID), "empresas\n")

##   submuestra_D.csv / .xlsx — 807 filas, 11 empresas

cat("  submuestras_analiticas.xlsx — todas en un archivo con 4 hojas\n")

##   submuestras_analiticas.xlsx — todas en un archivo con 4 hojas

cat("\nNota: la llave de unión entre transacciones y perfil es el campo 'ID' (UUID).\n")

## 
## Nota: la llave de unión entre transacciones y perfil es el campo 'ID' (UUID).

cat("Para recrear el join: left_join(ig_limpia, car_limpia, by = 'ID')\n")

## Para recrear el join: left_join(ig_limpia, car_limpia, by = 'ID')

5. Información de sesión

sessionInfo()

## R version 4.5.2 (2025-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=Spanish_Colombia.utf8  LC_CTYPE=Spanish_Colombia.utf8   
## [3] LC_MONETARY=Spanish_Colombia.utf8 LC_NUMERIC=C                     
## [5] LC_TIME=Spanish_Colombia.utf8    
## 
## time zone: America/Bogota
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] writexl_1.5.4    patchwork_1.3.2  corrplot_0.95    kableExtra_1.4.1
##  [5] knitr_1.51       broom_1.0.9      ggridges_0.5.7   scales_1.4.0    
##  [9] readxl_1.5.0     lubridate_1.9.4  forcats_1.0.0    stringr_1.6.0   
## [13] dplyr_1.2.1      purrr_1.2.2      readr_2.1.5      tidyr_1.3.2     
## [17] tibble_3.3.1     ggplot2_4.0.3    tidyverse_2.0.0 
## 
## loaded via a namespace (and not attached):
##  [1] sass_0.4.10        generics_0.1.4     xml2_1.4.0         stringi_1.8.7     
##  [5] hms_1.1.3          digest_0.6.37      magrittr_2.0.5     evaluate_1.0.5    
##  [9] grid_4.5.2         timechange_0.3.0   RColorBrewer_1.1-3 fastmap_1.2.0     
## [13] cellranger_1.1.0   jsonlite_2.0.0     backports_1.5.0    viridisLite_0.4.2 
## [17] textshaping_1.0.1  jquerylib_0.1.4    cli_3.6.5          crayon_1.5.3      
## [21] rlang_1.3.0        bit64_4.6.0-1      withr_3.0.2        cachem_1.1.0      
## [25] yaml_2.3.10        parallel_4.5.2     tools_4.5.2        tzdb_0.5.0        
## [29] vctrs_0.7.3        R6_2.6.1           lifecycle_1.0.5    bit_4.6.0         
## [33] vroom_1.6.5        pkgconfig_2.0.3    pillar_1.11.0      bslib_0.9.0       
## [37] gtable_0.3.6       glue_1.8.0         systemfonts_1.2.3  xfun_0.52         
## [41] tidyselect_1.2.1   rstudioapi_0.17.1  farver_2.1.2       htmltools_0.5.8.1 
## [45] labeling_0.4.3     rmarkdown_2.29     svglite_2.2.1      compiler_4.5.2    
## [49] S7_0.2.0

González Lozano, L.E. & Granados Rodríguez, H. (2026). ¿Gastan lo que entra? Hipótesis de ingresos permanentes en micronegocios bogotanos — Mi Diario Financiero, SDDE. Documento de trabajo exploratorio. Subdirección de Estudios Estratégicos / ODEB.

Caminito A

Análisis en dos etapas — Mi Diario Financiero, SDDE 2024–2026

Helen Granados Rodríguez & Luis Eduardo González Lozano

2026-09-17