Análisis Económico

El objetivo de está actividad es identificar las variables macroeconómicas que determinan el ingreso tributario en México, periodo 2010-2023. Se plantea como hipótesis que las variaciones de los ingresos tributarios (IT) son causadas por las variaciones del capital, medido por la suma de los volúmenes del Indice Mensual Bruta y por los niveles de la Población Económicamente Activa (PEA). Se selecciona como horizonte de investigación del año 2010 al 2023.

Por otra parte, sabemos que el PIB mide las remuneraciones de los factores de la producción; salarios de los trabajadores y renta del capital. Entonces, debe existir una función matemática que relacione estas variables para maximizar el producto o la recaudación tributaria.

Dado nuestro objetivo, la función Cobb-Douglas por su carácter instrumental en materia de política económica, que permite asociar los factores de la producción (capital y trabajo) y la tecnología para explicar, como se pretende en está actividad, la estructura de los ingresos tributarios y maximizar el producto.

Yt=KαLβ

La función está compuesta por dos factores productivos y un factor adicional. Yt = IT representa la producción K = IMB es el indice mensual bruto L = PA es la población activa. α y β son los parámetros que representan el peso de los factores.

library(readxl)
#install.packages("tsibble")
library(tsibble)
## 
## Attaching package: 'tsibble'
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, union
library(fpp3)
## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──
## ✔ tibble      3.2.1     ✔ tsibbledata 0.4.1
## ✔ dplyr       1.1.3     ✔ feasts      0.3.1
## ✔ tidyr       1.3.0     ✔ fable       0.3.3
## ✔ lubridate   1.9.3     ✔ fabletools  0.3.4
## ✔ ggplot2     3.4.4
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()     masks base::date()
## ✖ dplyr::filter()       masks stats::filter()
## ✖ tsibble::intersect()  masks base::intersect()
## ✖ lubridate::interval() masks tsibble::interval()
## ✖ dplyr::lag()          masks stats::lag()
## ✖ tsibble::setdiff()    masks base::setdiff()
## ✖ tsibble::union()      masks base::union()
library(fpp2)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## ── Attaching packages ────────────────────────────────────────────── fpp2 2.5 ──
## ✔ forecast  8.21.1     ✔ expsmooth 2.3   
## ✔ fma       2.5
## 
## 
## Attaching package: 'fpp2'
## The following object is masked from 'package:fpp3':
## 
##     insurance
library(zoo)
## 
## Attaching package: 'zoo'
## The following object is masked from 'package:tsibble':
## 
##     index
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
IndiceMensualBruta <- read_excel("IndiceMensualBruta.xlsx")
IndMB <- IndiceMensualBruta |>
  select(`INDICADOR MENSUAL BRUTA`) 

IngresosTributarios <- read_excel("IngresosTributarios.xls") 
IndT <- IngresosTributarios |>
  select(`Total de Ingresos tributarios`)

PoblacionActiva <- read_excel("PoblacionActiva.xls")
PobA <- PoblacionActiva |>
   select(`Poblacion economicamente activa`)
#Convertimos los datos en series de tiempo 
IMB.ts <- ts(IndMB, start = 2010, freq = 4)

IT.ts <- ts(IndT, start = 2010, freq = 4)

PA.ts <- ts(PobA, start = 2010, freq = 4)

Desestacionalizar Población Activa e Ingresos Tributarios

Estamos desestacionalizando los datos de los Ingresos Tributarios y posteriormente la Población Activa.

Se puede observar que en el segundo trimestre del 2020 hay un pico hacia abajo de la Población Activa, ya que trimestre tras trimestre iba al alza, pero a causa de la pandemia originó muchos desempleos, por lo que podría considerarse como datos atípicos.

Aplicar logaritmos y realizar la estimación de Parámetros

Ahora aplicaremos el logaritmo en cada serie, pero al aplicar el logaritmo natural en la ecuación nos quedaría así:

lnYt=αlnKt+βlnLt +εt

ladjPA <-log10(adjPA)
ladjIt<- log10(adjIT)
ladjIMB <- log10(IMB.ts)


Trimestres <- yearquarter(seq(as.Date(as.yearqtr("2010Q1")),
                      as.Date(as.yearqtr("2023Q2")), by = "quarter"))

data <- tibble(Trimestres,lnYt=ladjIt, lnLt = ladjPA, lnK=ladjIMB )

datac.ts<- as_tsibble(data, index = Trimestres)

regresion <- datac.ts|> model(tslm=TSLM(ladjIt ~ ladjIMB + ladjPA))
report(regresion)
## Series: ladjIt 
## Model: TSLM 
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.15809 -0.05524 -0.01207  0.05998  0.31176 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -33.2289     2.7991 -11.871 2.71e-16 ***
## ladjIMB      -0.7373     0.3440  -2.143   0.0369 *  
## ladjPA        5.2484     0.3747  14.006  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.08318 on 51 degrees of freedom
## Multiple R-squared: 0.7952,  Adjusted R-squared: 0.7872
## F-statistic: 99.01 on 2 and 51 DF, p-value: < 2.22e-16

Se observa que el modelo se ajusta a los datos con un 78.72% y con un error muy pequeño en la desviación de los datos.

Análisis de los residuos

regresion|> gg_tsresiduals()

Se puede observar que se pierde un poco de información debido a los datos atipicos que hay y por sus diferenias en la variabilidad de los datos, pero apesar de eso es muy baja la pérdida de información.

glance(regresion) |>
  select(adj_r_squared, CV, AIC, AICc, BIC)
## # A tibble: 1 × 5
##   adj_r_squared      CV   AIC  AICc   BIC
##           <dbl>   <dbl> <dbl> <dbl> <dbl>
## 1         0.787 0.00838 -264. -263. -256.
augment(regresion) |>
  features(.innov, ljung_box, lag = 10)
## # A tibble: 1 × 3
##   .model lb_stat lb_pvalue
##   <chr>    <dbl>     <dbl>
## 1 tslm      70.3  3.91e-11

Aquí se pueden observar diferentes criterios como: El Criterio de información de Akaike, Criterio de información de Akaike corregido, Criterio de información bayesiano de Schwarz, entre otros estos nos ayudan a medir que tan bueno es nuestro modelo y que tan bien estpa pronosticando los datos.

Prueba Dickey & Fuller

augment(regresion) |>
  features(ladjIt, unitroot_kpss)
## # A tibble: 1 × 3
##   .model kpss_stat kpss_pvalue
##   <chr>      <dbl>       <dbl>
## 1 tslm        1.40        0.01
augment(regresion) |>
  features(ladjPA, unitroot_kpss)
## # A tibble: 1 × 3
##   .model kpss_stat kpss_pvalue
##   <chr>      <dbl>       <dbl>
## 1 tslm        1.31        0.01
augment(regresion) |>
  features(ladjIMB, unitroot_kpss)
## # A tibble: 1 × 3
##   .model kpss_stat kpss_pvalue
##   <chr>      <dbl>       <dbl>
## 1 tslm       0.144         0.1

Se puede observar que la serie de tiempo de los Ingresos Tributarios y la de Población activa no son estacionarios, dado que la prueba de raiz unitaria dice que el p-Value debe ser menor a 0.01.

Diferenciamos los datos

augment(regresion) |>
  mutate(diff_it = difference(ladjIt)) |>
  features(diff_it, unitroot_kpss)
## # A tibble: 1 × 3
##   .model kpss_stat kpss_pvalue
##   <chr>      <dbl>       <dbl>
## 1 tslm       0.105         0.1
augment(regresion) |>
  mutate(diff_pa = difference(ladjPA)) |>
  features(diff_pa, unitroot_kpss)
## # A tibble: 1 × 3
##   .model kpss_stat kpss_pvalue
##   <chr>      <dbl>       <dbl>
## 1 tslm      0.0475         0.1

Ahora podemos observar que ya son estacionarias.

Grado de integración

augment(regresion) |>
  features(ladjIt, unitroot_ndiffs)
## # A tibble: 1 × 2
##   .model ndiffs
##   <chr>   <int>
## 1 tslm        1
augment(regresion) |>
  features(ladjPA, unitroot_ndiffs)
## # A tibble: 1 × 2
##   .model ndiffs
##   <chr>   <int>
## 1 tslm        1

Con esto podemos confirmar lo anterior que solo se necesito de una diferenciación para que sean estacionarias, por lo que podemos concluir que la serie de Ingresos Tributarios y la serie de Población Activa ambas tienen un grado de integración.