# --- [Cargar librerías y paquetes necesarios] ---
# Función que instala y carga automáticamente los paquetes requeridos
load_or_install <- function(packages) {
for (pkg in packages) {
if (!require(pkg, character.only = TRUE, quietly = TRUE)) {
install.packages(pkg, dependencies = TRUE)
library(pkg, character.only = TRUE)
message(paste("✅ Paquete instalado y cargado:", pkg))
} else {
message(paste("✔ Paquete ya disponible:", pkg))
}
}
}
# Lista actualizada de librerías utilizadas en la tesis
paquetes_necesarios <- c(
"tidyverse", # incluye dplyr, ggplot2, tidyr, readr, etc.
"readxl", # leer archivos Excel
"openxlsx", # leer y escribir Excel
"lubridate", # manejo de fechas
"scales", # formateo de ejes y porcentajes
"janitor", # limpiar nombres de columnas
"stringr", # manipulación de texto
"forcats", # manejo de factores
"data.table", # eficiencia en manejo de grandes datos
"knitr", # generación de reportes
"kableExtra", # tablas estéticas para reportes
"ggthemes", # temas visuales para ggplot2
"plotly", # gráficos interactivos
"broom", # conversión de resultados a data frames
"car", # pruebas estadísticas complementarias
"psych", # análisis descriptivo y psicométrico
"splm", # modelos de panel espacial
"spdep", # dependencias espaciales
"rlang", # gestión interna de entornos R
"ggpubr", # gráficos estadísticos listos para publicación
"lmtest", # pruebas de hipótesis y diagnóstico de modelos
"nortest", # pruebas de normalidad adicionales
"sp", # manejo de objetos espaciales
"urca", # pruebas de raíz unitaria (ADF, PP, etc.)
"spData", # conjuntos de datos espaciales
"plm", # modelos de panel
"sandwich", # estimadores robustos de varianza
"stargazer"
)
# Ejecutar instalación y carga
load_or_install(paquetes_necesarios)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.1 ✔ stringr 1.5.2
## ✔ ggplot2 4.0.0 ✔ 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
## ✔ Paquete ya disponible: tidyverse
##
## ✔ Paquete ya disponible: readxl
##
## ✔ Paquete ya disponible: openxlsx
##
## ✔ Paquete ya disponible: lubridate
##
##
## Adjuntando el paquete: 'scales'
##
##
## The following object is masked from 'package:purrr':
##
## discard
##
##
## The following object is masked from 'package:readr':
##
## col_factor
##
##
## ✔ Paquete ya disponible: scales
##
##
## Adjuntando el paquete: 'janitor'
##
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
##
##
## ✔ Paquete ya disponible: janitor
##
## ✔ Paquete ya disponible: stringr
##
## ✔ Paquete ya disponible: forcats
##
##
## Adjuntando el paquete: 'data.table'
##
##
## The following objects are masked from 'package:lubridate':
##
## hour, isoweek, mday, minute, month, quarter, second, wday, week,
## yday, year
##
##
## The following objects are masked from 'package:dplyr':
##
## between, first, last
##
##
## The following object is masked from 'package:purrr':
##
## transpose
##
##
## ✔ Paquete ya disponible: data.table
##
## ✔ Paquete ya disponible: knitr
##
##
## Adjuntando el paquete: 'kableExtra'
##
##
## The following object is masked from 'package:dplyr':
##
## group_rows
##
##
## ✔ Paquete ya disponible: kableExtra
##
## ✔ Paquete ya disponible: ggthemes
##
##
## Adjuntando el paquete: 'plotly'
##
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
##
## The following object is masked from 'package:stats':
##
## filter
##
##
## The following object is masked from 'package:graphics':
##
## layout
##
##
## ✔ Paquete ya disponible: plotly
##
## ✔ Paquete ya disponible: broom
##
##
## Adjuntando el paquete: 'car'
##
##
## The following object is masked from 'package:dplyr':
##
## recode
##
##
## The following object is masked from 'package:purrr':
##
## some
##
##
## ✔ Paquete ya disponible: car
##
##
## Adjuntando el paquete: 'psych'
##
##
## The following object is masked from 'package:car':
##
## logit
##
##
## The following objects are masked from 'package:scales':
##
## alpha, rescale
##
##
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
##
##
## ✔ Paquete ya disponible: psych
##
## ✔ Paquete ya disponible: splm
##
## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`
##
## Linking to GEOS 3.13.0, GDAL 3.10.1, PROJ 9.5.1; sf_use_s2() is TRUE
##
## ✔ Paquete ya disponible: spdep
##
##
## Adjuntando el paquete: 'rlang'
##
##
## The following object is masked from 'package:data.table':
##
## :=
##
##
## The following objects are masked from 'package:purrr':
##
## %@%, flatten, flatten_chr, flatten_dbl, flatten_int, flatten_lgl,
## flatten_raw, invoke, splice
##
##
## ✔ Paquete ya disponible: rlang
##
## ✔ Paquete ya disponible: ggpubr
##
##
## Adjuntando el paquete: 'zoo'
##
##
## The following objects are masked from 'package:data.table':
##
## yearmon, yearqtr
##
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
##
## ✔ Paquete ya disponible: lmtest
##
## ✔ Paquete ya disponible: nortest
##
## ✔ Paquete ya disponible: sp
##
## ✔ Paquete ya disponible: urca
##
## ✔ Paquete ya disponible: spData
##
##
## Adjuntando el paquete: 'plm'
##
##
## The following object is masked from 'package:data.table':
##
## between
##
##
## The following objects are masked from 'package:dplyr':
##
## between, lag, lead
##
##
## ✔ Paquete ya disponible: plm
##
## ✔ Paquete ya disponible: sandwich
##
##
## Please cite as:
##
##
## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
##
## R package version 5.2.3. https://CRAN.R-project.org/package=stargazer
##
##
## ✔ Paquete ya disponible: stargazer
# Configuración global para reportes
options(scipen = 16) # evita notación científica
theme_set(theme_minimal()) # tema base para ggplot
# Importar los archivo
pibe_2018 <- read_excel("DATOS LIMPIOS TESIS.xlsx", sheet = "PIBE precios 2018")
deuda_2018 <- read_excel("DATOS LIMPIOS TESIS.xlsx", sheet = "Deuda_p2018")
ip_2018 <- read_excel(
"DATOS LIMPIOS TESIS.xlsx",
sheet = "IP_2018",
range = "A1:O33"
)
# Crear vector con los estados de análisis
estados_foco <- c(
"Baja California Sur", "Chiapas", "Ciudad de México", "Colima",
"Estado de México", "Hidalgo", "Nuevo León", "Puebla", "San Luis Potosí", "Tlaxcala", "Veracruz","Zacatecas"
)
## Tablas reducidas
# Filtrar solo los estados de interés
pibe_2018_red <- pibe_2018 %>%
filter(Estado %in% estados_foco)
deuda_2018_red <- deuda_2018 %>%
filter(Estado %in% estados_foco)
# Renombrar columnas anuales para identificarlas
names(pibe_2018_red)[-1] <- paste0("PIB_", names(pibe_2018_red)[-1])
names(deuda_2018_red)[-1] <- paste0("Deuda_", names(deuda_2018_red)[-1])
# Verifica que cambió correctamente
head(pibe_2018_red)
## # A tibble: 6 × 15
## Estado PIB_2010 PIB_2011 PIB_2012 PIB_2013 PIB_2014 PIB_2015 PIB_2016 PIB_2017
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Baja … 138669. 144956. 147270. 145216. 147614. 156072. 163095. 170784.
## 2 Colima 125596. 133676. 135600. 133729. 135091. 141029. 140705. 150360.
## 3 Chiap… 355979. 361270. 370237. 360621. 374691. 364001. 369919. 359734.
## 4 Ciuda… 3125717. 3231440. 3332209. 3363394. 3412110. 3503520. 3571368. 3646318.
## 5 Hidal… 358637. 366544. 379811. 379720. 397901. 413909. 418466. 416409.
## 6 Estad… 1773210. 1852646. 1911402. 1923372. 1966749. 2007572. 2058753. 2166132.
## # ℹ 6 more variables: PIB_2018 <dbl>, PIB_2019 <dbl>, PIB_2020 <dbl>,
## # PIB_2021 <dbl>, PIB_2022 <dbl>, PIB_2023 <dbl>
head(deuda_2018_red)
## # A tibble: 6 × 15
## Estado Deuda_2010 Deuda_2011 Deuda_2012 Deuda_2013 Deuda_2014 Deuda_2015
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Baja Califo… 2923. 2523. 2278. 3241. 2944. 2718.
## 2 Colima 1951. 3205. 2943. 3647. 3392. 3932.
## 3 Chiapas 11621. 18945. 20724. 25587. 24017. 21619.
## 4 Ciudad de M… 69656. 72483. 73172. 75238. 77113. 79609.
## 5 Hidalgo 6928. 6115. 5391. 6012. 6210. 7998.
## 6 Estado de M… 54400. 51776. 51894. 49520. 46983. 47361.
## # ℹ 8 more variables: Deuda_2016 <dbl>, Deuda_2017 <dbl>, Deuda_2018 <dbl>,
## # Deuda_2019 <dbl>, Deuda_2020 <dbl>, Deuda_2021 <dbl>, Deuda_2022 <dbl>,
## # Deuda_2023 <dbl>
# Ahora une las tablas
datos_2018 <- left_join(pibe_2018_red, deuda_2018_red, by = "Estado")
# Listar nombres finales
names(datos_2018)
## [1] "Estado" "PIB_2010" "PIB_2011" "PIB_2012" "PIB_2013"
## [6] "PIB_2014" "PIB_2015" "PIB_2016" "PIB_2017" "PIB_2018"
## [11] "PIB_2019" "PIB_2020" "PIB_2021" "PIB_2022" "PIB_2023"
## [16] "Deuda_2010" "Deuda_2011" "Deuda_2012" "Deuda_2013" "Deuda_2014"
## [21] "Deuda_2015" "Deuda_2016" "Deuda_2017" "Deuda_2018" "Deuda_2019"
## [26] "Deuda_2020" "Deuda_2021" "Deuda_2022" "Deuda_2023"
datos_2018 <- datos_2018 %>%
mutate(across(matches("PIB_|Deuda_"), as.numeric))
summary(datos_2018)
## Estado PIB_2010 PIB_2011 PIB_2012
## Length:12 Min. : 121829 Min. : 125891 Min. : 128975
## Class :character 1st Qu.: 182557 1st Qu.: 184160 1st Qu.: 187791
## Mode :character Median : 376220 Median : 391326 Median : 408703
## Mean : 816705 Mean : 845296 Mean : 874897
## 3rd Qu.:1149151 3rd Qu.:1175365 3rd Qu.:1219025
## Max. :3125717 Max. :3231440 Max. :3332209
## PIB_2013 PIB_2014 PIB_2015 PIB_2016
## Min. : 128121 Min. : 130496 Min. : 137054 Min. : 139168
## 1st Qu.: 183427 1st Qu.: 195305 1st Qu.: 199972 1st Qu.: 203265
## Median : 414989 Median : 428968 Median : 446967 Median : 462161
## Mean : 875189 Mean : 893754 Mean : 916210 Mean : 930748
## 3rd Qu.:1208737 3rd Qu.:1222883 3rd Qu.:1244232 3rd Qu.:1230626
## Max. :3363394 Max. :3412110 Max. :3503520 Max. :3571368
## PIB_2017 PIB_2018 PIB_2019 PIB_2020
## Min. : 143920 Min. : 147753 Min. : 147877 Min. : 135083
## 1st Qu.: 208122 1st Qu.: 217446 1st Qu.: 209275 1st Qu.: 195965
## Median : 478326 Median : 488213 Median : 471829 Median : 432595
## Mean : 957660 Mean : 980955 Mean : 976483 Mean : 888259
## 3rd Qu.:1226894 3rd Qu.:1249686 3rd Qu.:1269702 3rd Qu.:1164230
## Max. :3646318 Max. :3694575 Max. :3679917 Max. :3293855
## PIB_2021 PIB_2022 PIB_2023 Deuda_2010
## Min. : 143213 Min. : 146642 Min. : 148529 Min. : 0
## 1st Qu.: 208960 1st Qu.: 213292 1st Qu.: 216925 1st Qu.: 2680
## Median : 454077 Median : 482023 Median : 508268 Median : 9490
## Mean : 941131 Mean : 975171 Mean :1008475 Mean :20811
## 3rd Qu.:1237391 3rd Qu.:1263648 3rd Qu.:1300937 3rd Qu.:35405
## Max. :3496056 Max. :3650378 Max. :3806102 Max. :69656
## Deuda_2011 Deuda_2012 Deuda_2013 Deuda_2014
## Min. : 75.91 Min. : 58.69 Min. : 0 Min. : 0
## 1st Qu.: 4571.44 1st Qu.: 4779.14 1st Qu.: 5421 1st Qu.: 5303
## Median : 9880.27 Median : 9492.03 Median : 9581 Median :10231
## Mean :22744.34 Mean :24719.55 Mean :25790 Mean :26286
## 3rd Qu.:41274.44 3rd Qu.:50742.04 3rd Qu.:49962 3rd Qu.:47806
## Max. :72483.03 Max. :73172.01 Max. :75238 Max. :78102
## Deuda_2015 Deuda_2016 Deuda_2017 Deuda_2018
## Min. : 39.02 Min. : 0 Min. : 0 Min. : 35.75
## 1st Qu.: 4872.39 1st Qu.: 4746 1st Qu.: 4159 1st Qu.: 4074.58
## Median : 9787.18 Median : 9235 Median : 8496 Median : 7996.55
## Mean :26563.60 Mean :26304 Mean :25835 Mean :25558.22
## 3rd Qu.:49047.42 3rd Qu.:48263 3rd Qu.:48165 3rd Qu.:47337.30
## Max. :79609.32 Max. :79648 Max. :81156 Max. :81726.52
## Deuda_2019 Deuda_2020 Deuda_2021 Deuda_2022
## Min. : 41.73 Min. : 15.05 Min. : 0 Min. : 0
## 1st Qu.: 3897.20 1st Qu.: 4071.69 1st Qu.: 3614 1st Qu.: 3517
## Median : 7549.54 Median : 6654.69 Median : 5641 Median : 5163
## Mean :24736.58 Mean :24743.50 Mean :24649 Mean :24781
## 3rd Qu.:43633.76 3rd Qu.:43486.63 3rd Qu.:43766 3rd Qu.:42353
## Max. :82212.50 Max. :81279.53 Max. :85005 Max. :84115
## Deuda_2023
## Min. : 0
## 1st Qu.: 3212
## Median : 4694
## Mean :24311
## 3rd Qu.:42726
## Max. :81938
# --- Calcular correlaciones PIB-Deuda por año ---
anos <- 2010:2023
resultados_cor_abs <- data.frame(
Año = anos,
Correlación = NA,
p_valor = NA,
N = NA
)
for (i in anos) {
pib_col <- paste0("PIB_", i)
deuda_col <- paste0("Deuda_", i)
# Verifica que existan las columnas
if (pib_col %in% names(datos_2018) && deuda_col %in% names(datos_2018)) {
# Extrae los vectores
x <- as.numeric(datos_2018[[deuda_col]]) # X → variable independiente
y <- as.numeric(datos_2018[[pib_col]]) # Y → variable dependiente
# Elimina pares con NA
ok <- complete.cases(x, y)
# Aplica test de correlación si hay al menos 3 observaciones válidas
if (sum(ok) >= 3) {
test <- cor.test(x[ok], y[ok], method = "pearson")
resultados_cor_abs[resultados_cor_abs$Año == i, "Correlación"] <- test$estimate
resultados_cor_abs[resultados_cor_abs$Año == i, "p_valor"] <- test$p.value
resultados_cor_abs[resultados_cor_abs$Año == i, "N"] <- sum(ok)
}
}
}
print(resultados_cor_abs)
## Año Correlación p_valor N
## 1 2010 0.9688472 0.0000002193072 12
## 2 2011 0.9537220 0.0000015464257 12
## 3 2012 0.9129016 0.0000340558567 12
## 4 2013 0.8930050 0.0000920461449 12
## 5 2014 0.8805096 0.0001564604018 12
## 6 2015 0.8865119 0.0001221899030 12
## 7 2016 0.8792905 0.0001642565001 12
## 8 2017 0.8854634 0.0001277061175 12
## 9 2018 0.8934088 0.0000903856861 12
## 10 2019 0.9122269 0.0000353543301 12
## 11 2020 0.9074943 0.0000455965273 12
## 12 2021 0.9273350 0.0000141104384 12
## 13 2022 0.9178704 0.0000256067498 12
## 14 2023 0.9129056 0.0000340481639 12
##¿Por que no son relevantes los resultados anteriores?
#Al trabajar con valores absolutos las diferentes escalas de la economía ocultan las diferencias, las entidades con mayores economías tienen deudas más grandes y se respeta la situación para el caso contrario.Por eso debaría usar logaritmos para tener una visión proporcional
#debido a que tlaxcala tiene endeudamiento 0 durante varios periodos y es relevante mantenerlo es necesario hacer un ligero ajuste
datos_log <- datos_2018 %>%
mutate(
across(starts_with("PIB_"), ~log(.), .names = "ln_{.col}"),
across(starts_with("Deuda_"), ~log(. + 1), .names = "ln_{.col}")
)
# Calcular las diferencias (crecimientos)
for (i in 2011:2023) {
col_pib_t <- paste0("ln_PIB_", i)
col_pib_t1 <- paste0("ln_PIB_", i - 1)
col_deuda_t <- paste0("ln_Deuda_", i)
col_deuda_t1 <- paste0("ln_Deuda_", i - 1)
datos_log[[paste0("dln_PIB_", i)]] <- datos_log[[col_pib_t]] - datos_log[[col_pib_t1]]
datos_log[[paste0("dln_Deuda_", i)]] <- datos_log[[col_deuda_t]] - datos_log[[col_deuda_t1]]
}
# Confirmar que no hay NA o -Inf
summary(select(datos_log, starts_with("ln_")))
## ln_PIB_2010 ln_PIB_2011 ln_PIB_2012 ln_PIB_2013
## Min. :11.71 Min. :11.74 Min. :11.77 Min. :11.76
## 1st Qu.:12.10 1st Qu.:12.12 1st Qu.:12.13 1st Qu.:12.11
## Median :12.84 Median :12.88 Median :12.92 Median :12.93
## Mean :13.06 Mean :13.10 Mean :13.13 Mean :13.12
## 3rd Qu.:13.94 3rd Qu.:13.96 3rd Qu.:14.00 3rd Qu.:13.99
## Max. :14.96 Max. :14.99 Max. :15.02 Max. :15.03
## ln_PIB_2014 ln_PIB_2015 ln_PIB_2016 ln_PIB_2017
## Min. :11.78 Min. :11.83 Min. :11.84 Min. :11.88
## 1st Qu.:12.17 1st Qu.:12.20 1st Qu.:12.22 1st Qu.:12.24
## Median :12.97 Median :13.01 Median :13.04 Median :13.07
## Mean :13.15 Mean :13.18 Mean :13.19 Mean :13.22
## 3rd Qu.:14.00 3rd Qu.:14.01 3rd Qu.:14.00 3rd Qu.:13.99
## Max. :15.04 Max. :15.07 Max. :15.09 Max. :15.11
## ln_PIB_2018 ln_PIB_2019 ln_PIB_2020 ln_PIB_2021
## Min. :11.90 Min. :11.90 Min. :11.81 Min. :11.87
## 1st Qu.:12.29 1st Qu.:12.25 1st Qu.:12.18 1st Qu.:12.24
## Median :13.09 Median :13.06 Median :12.97 Median :13.02
## Mean :13.25 Mean :13.24 Mean :13.15 Mean :13.21
## 3rd Qu.:14.00 3rd Qu.:14.02 3rd Qu.:13.93 3rd Qu.:13.99
## Max. :15.12 Max. :15.12 Max. :15.01 Max. :15.07
## ln_PIB_2022 ln_PIB_2023 ln_Deuda_2010 ln_Deuda_2011
## Min. :11.90 Min. :11.91 Min. : 0.000 Min. : 4.343
## 1st Qu.:12.27 1st Qu.:12.28 1st Qu.: 7.880 1st Qu.: 8.410
## Median :13.08 Median :13.13 Median : 9.132 Median : 9.148
## Mean :13.24 Mean :13.27 Mean : 8.525 Mean : 9.095
## 3rd Qu.:14.01 3rd Qu.:14.04 3rd Qu.:10.450 3rd Qu.:10.618
## Max. :15.11 Max. :15.15 Max. :11.151 Max. :11.191
## ln_Deuda_2012 ln_Deuda_2013 ln_Deuda_2014 ln_Deuda_2015
## Min. : 4.089 Min. : 0.000 Min. : 0.000 Min. : 3.689
## 1st Qu.: 8.441 1st Qu.: 8.577 1st Qu.: 8.550 1st Qu.: 8.485
## Median : 9.119 Median : 9.151 Median : 9.231 Median : 9.188
## Mean : 9.111 Mean : 8.851 Mean : 8.849 Mean : 9.164
## 3rd Qu.:10.834 3rd Qu.:10.819 3rd Qu.:10.774 3rd Qu.:10.799
## Max. :11.201 Max. :11.228 Max. :11.266 Max. :11.285
## ln_Deuda_2016 ln_Deuda_2017 ln_Deuda_2018 ln_Deuda_2019
## Min. : 0.000 Min. : 0.000 Min. : 3.604 Min. : 3.755
## 1st Qu.: 8.458 1st Qu.: 8.332 1st Qu.: 8.313 1st Qu.: 8.263
## Median : 9.131 Median : 9.047 Median : 8.982 Median : 8.921
## Mean : 8.842 Mean : 8.786 Mean : 9.043 Mean : 9.010
## 3rd Qu.:10.781 3rd Qu.:10.781 3rd Qu.:10.765 3rd Qu.:10.682
## Max. :11.285 Max. :11.304 Max. :11.311 Max. :11.317
## ln_Deuda_2020 ln_Deuda_2021 ln_Deuda_2022 ln_Deuda_2023
## Min. : 2.776 Min. : 0.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 8.311 1st Qu.: 8.192 1st Qu.: 8.164 1st Qu.: 8.073
## Median : 8.795 Median : 8.636 Median : 8.547 Median : 8.450
## Mean : 8.926 Mean : 8.601 Mean : 8.595 Mean : 8.525
## 3rd Qu.:10.679 3rd Qu.:10.681 3rd Qu.:10.644 3rd Qu.:10.653
## Max. :11.306 Max. :11.350 Max. :11.340 Max. :11.314
#Generamos pruebas de correlación
# Crear una tabla vacía donde guardar resultados
resultados_cor <- data.frame(
Año = integer(),
Correlación = numeric(),
P_value = numeric(),
IC_inf = numeric(),
IC_sup = numeric(),
Significativo = character(),
stringsAsFactors = FALSE
)
# Calcular correlaciones año a año
for (i in 2011:2023) {
col_pib <- paste0("dln_PIB_", i)
col_deuda <- paste0("dln_Deuda_", i)
# Filtrar observaciones válidas
df_temp <- datos_log[!is.na(datos_log[[col_pib]]) & !is.na(datos_log[[col_deuda]]), ]
# Ejecutar prueba de correlación
test <- cor.test(df_temp[[col_pib]], df_temp[[col_deuda]])
# Guardar resultados esenciales
resultados_cor <- rbind(
resultados_cor,
data.frame(
Año = i,
Correlación = round(test$estimate, 3),
P_value = round(test$p.value, 4),
IC_inf = round(test$conf.int[1], 3),
IC_sup = round(test$conf.int[2], 3),
Significativo = ifelse(test$p.value < 0.05, "Sí", "No")
)
)
}
# Mostrar tabla ordenada
print(resultados_cor)
## Año Correlación P_value IC_inf IC_sup Significativo
## cor 2011 -0.239 0.4537 -0.715 0.388 No
## cor1 2012 0.017 0.9570 -0.562 0.585 No
## cor2 2013 -0.051 0.8745 -0.607 0.539 No
## cor3 2014 0.726 0.0075 0.262 0.918 Sí
## cor4 2015 0.316 0.3174 -0.315 0.753 No
## cor5 2016 0.014 0.9649 -0.564 0.583 No
## cor6 2017 0.307 0.3321 -0.324 0.749 No
## cor7 2018 0.013 0.9683 -0.565 0.582 No
## cor8 2019 -0.590 0.0435 -0.869 -0.024 Sí
## cor9 2020 -0.007 0.9836 -0.578 0.569 No
## cor10 2021 -0.119 0.7132 -0.648 0.488 No
## cor11 2022 -0.151 0.6395 -0.667 0.463 No
## cor12 2023 0.223 0.4862 -0.402 0.706 No
# Ejemplo para el ultimo año
año <- 2023
col_pib <- paste0("dln_PIB_", año)
col_deuda <- paste0("dln_Deuda_", año)
ggplot(datos_log, aes(x = !!sym(col_deuda), y = !!sym(col_pib))) +
geom_point(size = 3, color = "#2E86C1", alpha = 0.7) +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(
title = paste("Relación entre crecimiento del PIB y crecimiento de la deuda - Año", año),
x = "Δln(Deuda) (crecimiento de la deuda)",
y = "Δln(PIB) (crecimiento económico)"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
datos_panel <- datos_log %>%
select(Estado, starts_with("dln_PIB_"), starts_with("dln_Deuda_")) %>%
pivot_longer(
cols = -Estado,
names_to = c(".value", "Año"),
names_pattern = "dln_(PIB|Deuda)_(\\d+)"
) %>%
mutate(Año = as.integer(Año))
#Tlaxcala esta dominando el eje X por lo que voy a eliminarlo de la grafica
datos_panel_plot <- datos_panel %>%
filter(Estado != "Tlaxcala")
#Graficando todos los años y Estados
ggplot(datos_panel, aes(x = Deuda, y = PIB)) +
geom_point(aes(color = Estado), alpha = 0.7, size = 2) +
geom_smooth(method = "lm", se = FALSE, color = "black", linewidth = 1) +
labs(
title = "Relación entre crecimiento del PIB y crecimiento de la deuda (2011–2023)",
subtitle = "12 entidades federativas mexicanas",
x = "Crecimiento de la deuda (Δln Deuda)",
y = "Crecimiento económico (Δln PIB)"
) +
theme_minimal() +
theme(legend.position = "bottom")
#interactivo
p <- ggplot(datos_panel_plot, aes(x = Deuda, y = PIB, color = Estado)) +
geom_point(alpha = 0.8, size = 2) +
geom_smooth(method = "lm", se = FALSE, color = "black") +
labs(
title = "Crecimiento del PIB vs Deuda (2011–2023), Sin tlaxcala",
x = "Δln(Deuda)",
y = "Δln(PIB)"
) +
theme_minimal()
ggplotly(p)
p_global <- ggplot(datos_panel_plot, aes(x = Deuda, y = PIB)) +
geom_point(aes(color = Estado), alpha = 0.75, size = 2) +
geom_smooth(method = "lm", formula = y ~ x, se = FALSE, color = "black", linewidth = 1) +
labs(
title = "Relación entre crecimiento del PIB y crecimiento de la deuda (2011–2023)",
subtitle = "11 entidades federativas mexicanas (sin Tlaxcala por escala)",
x = "Crecimiento de la deuda (Δln Deuda)",
y = "Crecimiento económico (Δln PIB)"
) +
theme_minimal() +
theme(legend.position = "bottom")
print(p_global)
#facetado por años
ggplot(datos_panel_plot, aes(x = Deuda, y = PIB, color = Estado)) +
geom_point(alpha = 0.7, size = 2) +
geom_smooth(method = "lm", se = FALSE, color = "black") +
facet_wrap(~Año, scales = "free") +
labs(
title = "Relación entre Δln(PIB) y Δln(Deuda) por año",
subtitle = "Sin Tlaxcala",
x = "Crecimiento de la deuda (Δln Deuda)",
y = "Crecimiento económico (Δln PIB)"
) +
theme_light() +
theme(legend.position = "none")
# facetado por entidad
ggplot(datos_panel, aes(x = Deuda, y = PIB)) +
geom_point(color = "#2E86C1", alpha = 0.7, linewidth = 2) +
geom_smooth(method = "lm", se = FALSE, color = "red") +
facet_wrap(~Estado, scales = "free") +
labs(
title = "Relación entre crecimiento de la deuda y del PIB por entidad (2011–2023)",
x = "Crecimiento de la deuda (Δln Deuda)",
y = "Crecimiento económico (Δln PIB)"
) +
theme_minimal()
## Warning in geom_point(color = "#2E86C1", alpha = 0.7, linewidth = 2): Ignoring
## unknown parameters: `linewidth`
# Histograma y QQ plot
ggqqplot(datos_panel$PIB, title = "QQ-Plot crecimiento del PIB")
ggqqplot(datos_panel$Deuda, title = "QQ-Plot crecimiento de la deuda")
# Prueba de Shapiro-Wilk
shapiro.test(datos_panel$PIB)
##
## Shapiro-Wilk normality test
##
## data: datos_panel$PIB
## W = 0.89836, p-value = 0.000000006414
shapiro.test(datos_panel$Deuda)
##
## Shapiro-Wilk normality test
##
## data: datos_panel$Deuda
## W = 0.41321, p-value < 0.00000000000000022
#Confirmamos con otras pruebas
ad.test(datos_panel$PIB) # Anderson-Darling
##
## Anderson-Darling normality test
##
## data: datos_panel$PIB
## A = 4.5672, p-value = 0.00000000002253
lillie.test(datos_panel$PIB) # Lilliefors
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: datos_panel$PIB
## D = 0.14348, p-value = 0.00000002434
#Todos los test rechazan la normalidad
#Dada la no normalidad de la muestra se podría optar por modelos no parametricos como ANOVA, sin embargo
#Al ser de un analisis de tipo panel puedo comparar que los residuos sean normales,
#Aunque las variables no lo sean.
pdim(datos_panel)
## Balanced Panel: n = 12, T = 13, N = 156
# Efectivamente es un panel balanceado, con N=12, T=13 y N=156
adf_pib <- ur.df(datos_panel$PIB, type = "drift", lags = 1)
summary(adf_pib)
##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression drift
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.164166 -0.015254 0.004413 0.023907 0.092128
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.018386 0.003771 4.876 0.00000272 ***
## z.lag.1 -1.172075 0.114228 -10.261 < 0.0000000000000002 ***
## z.diff.lag 0.158097 0.080227 1.971 0.0506 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04113 on 151 degrees of freedom
## Multiple R-squared: 0.5184, Adjusted R-squared: 0.512
## F-statistic: 81.28 on 2 and 151 DF, p-value: < 0.00000000000000022
##
##
## Value of test-statistic is: -10.2608 52.6425
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau2 -3.46 -2.88 -2.57
## phi1 6.52 4.63 3.81
#“De acuerdo con la prueba ADF (Augmented Dickey–Fuller), la serie del crecimiento del PIB (∆ln PIB) presenta un valor estadístico de −10.26, menor al valor crítico al 5% (−2.88). En consecuencia, se rechaza la hipótesis nula de raíz unitaria, concluyendo que la serie es estacionaria en niveles. Esto implica que las fluctuaciones en el crecimiento económico no presentan una tendencia persistente en el tiempo y son apropiadas para su inclusión en modelos econométricos de panel.”
# 1. Verifica normalidad de RESIDUOS, no variables
modelo_fe_resi <- plm(PIB ~ Deuda, data = datos_panel, model = "within")
residuos <- resid(modelo_fe_resi)
shapiro.test(residuos)
##
## Shapiro-Wilk normality test
##
## data: residuos
## W = 0.87693, p-value = 0.0000000004594
pdata <- pdata.frame(datos_panel, index = c("Estado", "Año"))
## Modelo de Efectos Fijos (DENTRO)
modelo_fe <- plm(PIB ~ Deuda, data = pdata, model = "within")
summary(modelo_fe)
## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = PIB ~ Deuda, data = pdata, model = "within")
##
## Balanced Panel: n = 12, T = 13, N = 156
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.178378 -0.012260 0.006007 0.023010 0.098931
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## Deuda 0.0025605 0.0044773 0.5719 0.5683
##
## Total Sum of Squares: 0.2557
## Residual Sum of Squares: 0.25511
## R-Squared: 0.0022819
## Adj. R-Squared: -0.081443
## F-statistic: 0.327062 on 1 and 143 DF, p-value: 0.56829
bptest(modelo_fe)
##
## studentized Breusch-Pagan test
##
## data: modelo_fe
## BP = 0.33662, df = 1, p-value = 0.5618
pbgtest(modelo_fe)
##
## Breusch-Godfrey/Wooldridge test for serial correlation in panel models
##
## data: PIB ~ Deuda
## chisq = 78.303, df = 13, p-value = 0.00000000002299
## alternative hypothesis: serial correlation in idiosyncratic errors
pcdtest(modelo_fe)
##
## Pesaran CD test for cross-sectional dependence in panels
##
## data: PIB ~ Deuda
## z = 20.564, p-value < 0.00000000000000022
## alternative hypothesis: cross-sectional dependence
## Objetos eliminados: i, x, y
## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 4342808 232.0 7178482 383.4 7178482 383.4
## Vcells 7701099 58.8 14786712 112.9 10740491 82.0
## Objetos actuales en el entorno:
## [1] "adf_pib" "anos" "año"
## [4] "col_deuda" "col_deuda_t" "col_deuda_t1"
## [7] "col_pib" "col_pib_t" "col_pib_t1"
## [10] "datos_2018" "datos_log" "datos_panel"
## [13] "datos_panel_plot" "deuda_2018" "deuda_2018_red"
## [16] "deuda_col" "df_temp" "estados_foco"
## [19] "existentes" "ip_2018" "load_or_install"
## [22] "modelo_fe" "modelo_fe_resi" "objetos_a_eliminar"
## [25] "ok" "p" "p_global"
## [28] "paquetes_necesarios" "pdata" "pib_col"
## [31] "pibe_2018" "pibe_2018_red" "residuos"
## [34] "resultados_cor" "resultados_cor_abs" "test"
# El modelo de efectos fijos muestra que existe un crecimiento practicamente nulo del PIB
# ademas de no ser estadisticamente significativo, por lo que no se puede rechazar que el
# el crecimiento de la deuda no afecta en el crecimiento economico.
#El modelo de efectos fijos viola algunos supuestos de auto correlación serial (hay inercia)
#y dependencia cruzada, es decir entre los estados (tambien logico)
# --- Errores robustos Driscoll–Kraay ---
res_robust_dk <- coeftest(modelo_fe, vcov = vcovSCC(modelo_fe, type = "HC0"))
print(res_robust_dk)
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## Deuda 0.0025605 0.0022472 1.1394 0.2564
# --- Errores robustos Arellano (por entidad) ---
res_robust_arellano <- coeftest(modelo_fe, vcov = vcovHC(modelo_fe, type = "HC1", cluster = "group"))
print(res_robust_arellano)
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## Deuda 0.0025605 0.0014084 1.8181 0.07114 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# --- Generar errores robustos ---
se_clasico <- sqrt(diag(vcov(modelo_fe)))
se_dk <- sqrt(diag(vcovSCC(modelo_fe, type = "HC0")))
se_arellano <- sqrt(diag(vcovHC(modelo_fe, type = "HC1", cluster = "group")))
# --- Tabla comparativa con Stargazer ---
p_values <- c(0.568, 0.256, 0.071)
stargazer(modelo_fe, modelo_fe, modelo_fe,
type = "text",
se = list(se_clasico, se_dk, se_arellano),
column.labels = c("Clásico", "Driscoll–Kraay", "Arellano"),
dep.var.labels = "Crecimiento del PIB (∆ln)",
covariate.labels = "Crecimiento de la deuda (∆ln)",
digits = 4,
add.lines = list(c("p-value", p_values)),
model.numbers = FALSE,
header = FALSE)
##
## ==============================================================
## Dependent variable:
## --------------------------------
## Crecimiento del PIB (∆ln)
## Clásico Driscoll–Kraay Arellano
## --------------------------------------------------------------
## Crecimiento de la deuda (∆ln) 0.0026 0.0026 0.0026*
## (0.0045) (0.0022) (0.0014)
##
## --------------------------------------------------------------
## p-value 0.568 0.256 0.071
## Observations 156 156 156
## R2 0.0023 0.0023 0.0023
## Adjusted R2 -0.0814 -0.0814 -0.0814
## F Statistic (df = 1; 143) 0.3271 0.3271 0.3271
## ==============================================================
## Note: *p<0.1; **p<0.05; ***p<0.01