FORMACION DE CAPITAL 2DO PARCIAL

MODELO

capital<-read.csv(file.choose())
View(capital)
st<-ts(capital$fk,frequency = 4, start = c(1994,1))

library(readr)
library(gridExtra)
library(forecast)
library(fpp2)
library(lmtest)
library(TSA)
library(urca)
library(ggplot2)
library(rmarkdown)
library(zoo)

1 BREVE DESCRIPCION DE LA SERIE ELEGIDA, ASI COMO SU FRECUENCIA, UNIDAD DE MEDIDA, FUENTE, ETC.

Se describe como “bien de capital” de forma universal a todos aquellos equipos, inmuebles e instalaciones que son utilizadas por una compañía para producir y ofrecer todos sus productos o servicios; si se está hablando de negocios que operan internacionalmente, los bienes de capital son todos las gastos que tienen las compañías mientras se encuentran operativas, incluyendo manutención de oficinas (pago de alquiler, papelería) y uniformes de los empleados.

Los bienes de capital serán utilizados para ser parte del proceso productivo de otro bien, teniendo en cuenta que este tipo de bienes son duraderos ya que los capitalistas invertirán de la mejor forma para adquirir la mejor maquinaria y esto les ayude a una mayor obtención de beneficio. Los bienes de capital al ser fusionado con el capital humano van a generar el proceso de acumulación de capital, esto es generado por que la maquinaria será la encargada de transformar lo puesto en marca en el proceso de producción y el trabajador tendrá las habilidades físico-intelectuales que le ayudaran a maniobrar los bienes de capital para sacarle el mejor provecho. Dentro de la teoría económica tradicional, la industria de bienes de capital desempeña el papel de pivote del desarrollo económico, y por medio de ella se mide el nivel tecnológico y lo avanzado del sector productivo. Sin embargo, en la actualidad estas afirmaciones se han puesto a prueba, ya que el desarrollo dc la microelectrónica y de algunas ramas del sector servicios, como los puntales del avance tecnológico, parecen contradecir esos postulados. Importaciones de bienes de capital.

Fuente: INEGI. Importaciones de bienes de capital Periodicidad: Trimestral

Unidad de medida: miles de millones de pesos

Fecha inicial: Enero/1994

Fecha final: Diciembre/ 2017

Fecha de consulta: 17/08/2018 18:39:24

Índice base 2013=100

2 GRAFICAR LOS DATOS, ANALIZAR LOS PATRONES Y OBSERVACIONES ATIPICAS. APOYE SU ANALISIS CON UNA DESCOMPOSICION CLASICA.

plot(st, main="formacion de capital", xlab = "Años", ylab = "capital")

El siguiente gráfico se pudede visualizar cada componente de la serie, los datos originales, la tendencia, la estacionalidad, y los residuos

fit<- decompose(st, type = "additive")
autoplot(fit)

3 SI ES NECESARIO, UTILIZAR TRANSFORMACION BOX-COX/ LOGARITMOS PARA ESTABILIZAR LA VARIANZA

aplique la funcion BOXCOX para estabilizar la varianza pero no corrio el comando

BoxCox.ar(st)

possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1Error in solve.default(res$hessian * length(x)) : 
  Lapack routine dgesv: system is exactly singular: U[2,2] = 0

entonces aploque logaritmos

plot(diff(diff(log(st))), type="l")

aplique diferencia de la diferencia del logaritmo y logre qu ela varianza de la serie se estabilizara asi como se quito la tendencia marcada que tenia al principio

4.- En caso de estacionalidad, aplicar diferencias estacionales.

la serie muestra que tiene una tendencia muuuy marcada y poca estacionalidad por lo que aplicamos diferencias no estacionales. que nos ayudaran a quitar la tendencia y ajustar la estacionalidad como lo podemos ver en la grafica 3

logk1<-plot(log(st), main="formacionde capital")

dlogk2<-plot(diff(log(st)),main="diferencia de logaritmo de formacionde capital")

dlogk3<-plot(diff(st, difference=2),main= "segunda diferencia de formacionde capital")
grid(logk1, dlogk2, dlogk3)

aqui de nueva cuenta se pudo estabilizar hasta la segunda diferencia por lo que se ve en la grafica.

5.-Usar prueba Dickey-Fuller para evaluar el orden de integracion de la serie. Diferenciar hasta que la serie sea estacionaria.

summary(ur.df(st))

############################################### 
# Augmented Dickey-Fuller Test Unit Root Test # 
############################################### 

Test regression none 


Call:
lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)

Residuals:
    Min      1Q  Median      3Q     Max 
-155741   -8811    6762   19153   72392 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
z.lag.1     0.016639   0.009268   1.795   0.0759 .  
z.diff.lag -0.404709   0.096899  -4.177 6.72e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 34910 on 92 degrees of freedom
Multiple R-squared:  0.1674,    Adjusted R-squared:  0.1493 
F-statistic: 9.249 on 2 and 92 DF,  p-value: 0.0002187


Value of test-statistic is: 1.7953 

Critical values for test statistics: 
     1pct  5pct 10pct
tau1 -2.6 -1.95 -1.61

H0=No es estacionaria (+0.05) H1=Es estacionaria (-0.05)

el p-value: 0.0002187 por lo que se rechaza la hipotesis nula , o se acepta la alternativa. por lo que nos dice que la serie ya es estacionaria.

6. Usar herramientas ACF, PACF, EACF y criterios de Akaike/ Bayes para construir propuestas de modelos.

st<- log(st)
ggtsdisplay(diff(st,4))

ggtsdisplay(diff(st,1))

ggtsdisplay(diff(diff(st,4)))

tambien observamos que hasta aplicar la segunda diferencia se puede estabilizar la serie. ahora procedere a hacer algunas propuestas

PROPUESTA 1 AR1

fit1<-auto.arima(st)
fit1

Series: st 
ARIMA(0,1,0)(2,0,0)[4] 

Coefficients:
        sar1    sar2
      0.3478  0.3495
s.e.  0.1257  0.1285

sigma^2 estimated as 0.008466:  log likelihood=91.68
AIC=-177.36   AICc=-177.1   BIC=-169.7

checkresiduals(fit1)

    Ljung-Box test

data:  Residuals from ARIMA(0,0,1)(2,1,0)[4]
Q* = 9.3732, df = 5, p-value = 0.09507

Model df: 3.   Total lags used: 8

PROPUESTA 2 ARIMA(1,0,0)(1,1,0)

fit2<-Arima(st,order=c(1,0,0),seasonal=c(1,1,0))
fit2

Series: st 
ARIMA(1,0,0)(1,1,0)[4] 

Coefficients:
         ar1     sar1
      0.8964  -0.4789
s.e.  0.0469   0.1261

sigma^2 estimated as 0.008809:  log likelihood=87.11
AIC=-168.21   AICc=-167.94   BIC=-160.65

checkresiduals(fit2)

    Ljung-Box test

data:  Residuals from ARIMA(1,0,0)(1,1,0)[4]
Q* = 16.094, df = 6, p-value = 0.01326

Model df: 2.   Total lags used: 8

PROPUESTA 3 ARIMA(2,1,0)(1,1,0)

fit3<-Arima(st, order=c(2,1,0),seasonal=c(1,1,0))
fit3

Series: st 
ARIMA(2,1,0)(1,1,0)[4] 

Coefficients:
         ar1      ar2     sar1
      0.1570  -0.0079  -0.5533
s.e.  0.1111   0.1054   0.1284

sigma^2 estimated as 0.00914:  log likelihood=85.33
AIC=-162.66   AICc=-162.2   BIC=-152.62

checkresiduals(fit3)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,0)(1,1,0)[4]
Q* = 9.3123, df = 5, p-value = 0.09724

Model df: 3.   Total lags used: 8

PROPUESTA 4 MA(1)

fit4<-Arima(st, order=c(0,1,1),seasonal=c(0,1,1))
fit4

Series: st 
ARIMA(0,1,1)(0,1,1)[4] 

Coefficients:
         ma1     sma1
      0.1030  -0.9999
s.e.  0.1138   0.1057

sigma^2 estimated as 0.006641:  log likelihood=93.77
AIC=-181.54   AICc=-181.27   BIC=-174.01

checkresiduals(fit4)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,1)(0,1,1)[4]
Q* = 12.685, df = 6, p-value = 0.04832

Model df: 2.   Total lags used: 8

PROPUESTA 5 ARIMA(1,0,1)(0,1,1)[4]

fit5<-Arima(st, order=c(1,0,1),seasonal=c(0,1,1))
fit5

Series: st 
ARIMA(1,0,1)(0,1,1)[4] 

Coefficients:
         ar1     ma1     sma1
      0.9123  0.1933  -0.5745
s.e.  0.0497  0.1018   0.1008

sigma^2 estimated as 507484449:  log likelihood=-1052.45
AIC=2112.91   AICc=2113.37   BIC=2123

checkresiduals(fit5)

    Ljung-Box test

data:  Residuals from ARIMA(1,0,1)(0,1,1)[4]
Q* = 7.5638, df = 5, p-value = 0.182

Model df: 3.   Total lags used: 8

PROPUESTA 6 ARIMA(0,1,0)

fit6<-Arima(st, order=c(0,1,0),seasonal=c(0,1,1))
fit6

Series: st 
ARIMA(0,1,0)(0,1,1)[4] 

Coefficients:
         sma1
      -0.6523
s.e.   0.0910

sigma^2 estimated as 531227091:  log likelihood=-1043.86
AIC=2091.71   AICc=2091.85   BIC=2096.73

checkresiduals(fit6)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)(0,1,1)[4]
Q* = 10.299, df = 7, p-value = 0.1722

Model df: 1.   Total lags used: 8

despues de proponer 6 modelos diferentes opto por la propuesta numero 5 ARIMA(1,0,1)(0,1,1), ya que los rezagos se ve que no se salen de las graficas, se ajutaron muy bien

7 COMO PARTE DEL DIAGNOSTICO DEL MODELO, ANALIZAR LOS RESIDUOS Y APLOCAR LA PRUEBA LJUNG-BOX

checkresiduals(fit5)

    Ljung-Box test

data:  Residuals from ARIMA(1,0,1)(0,1,1)[4]
Q* = 4.3244, df = 5, p-value = 0.5037

Model df: 3.   Total lags used: 8

8 USAR LA FUNCION.ARIMA() Y COMPARE SUS RESULTADOS CON EL INCISO ANTERIOS

fit7<-auto.arima(st,stepwise = FALSE, approximation = FALSE)
fit7

Series: st 
ARIMA(2,0,1)(0,1,1)[4] with drift 

Coefficients:

NaNs produced

         ar1      ar2      ma1    sma1     drift
      1.8165  -0.8745  -0.9568  -0.568  5453.455
s.e.     NaN      NaN      NaN     NaN       NaN

sigma^2 estimated as 437160568:  log likelihood=-1045.55
AIC=2103.09   AICc=2104.08   BIC=2118.22

checkresiduals(fit7)

    Ljung-Box test

data:  Residuals from ARIMA(2,0,1)(0,1,1)[4] with drift
Q* = 3.5547, df = 3, p-value = 0.3137

Model df: 5.   Total lags used: 8

9 PRESENTE LA ECUACION FINAL Y DESCRIBA

la ecuacion se ha determinado a partir del proceso de auto.arima es:

\[ y_t= 0.3478e_t_1+0.3495e_t_2 \]

10 CREAR UN PRONOSTICO A DOS AÑOS

##### Pronostico a partir de auto.arima (2 años) #####
pronostico<-plot(forecast(fit7,h=24))

pronostico

$`mean`
         Qtr1     Qtr2     Qtr3
2018 590423.2 631835.5 649605.8
2019 597706.0 643131.4 665021.5
2020 620712.0 669230.4 693576.9
2021 652067.3 700944.3 725029.8
2022 681530.3 728911.9 751332.6
2023 704454.7 750318.5 771435.4
         Qtr4
2018 663532.1
2019 682922.0
2020 713234.1
2021 743899.5
2022 768485.8
2023 787547.8

$lower
             80%      95%
2018 Q1 563627.3 549442.5
2018 Q2 596497.5 577790.8
2018 Q3 609757.7 588663.4
2018 Q4 621522.2 599283.4
2019 Q1 551333.2 526785.0
2019 Q2 594981.5 569492.5
2019 Q3 616452.3 590741.3
2019 Q4 634352.6 608641.5
2020 Q1 571718.2 545782.5
2020 Q2 620235.4 594298.9
2020 Q3 644339.3 618274.6
2020 Q4 663139.0 636620.2
2021 Q1 601964.0 575440.9
2021 Q2 650623.5 623985.3
2021 Q3 674125.5 647178.3
2021 Q4 692046.3 664596.9
2022 Q1 629675.9 602225.9
2022 Q2 677027.0 649560.7
2022 Q3 699326.0 671795.3
2022 Q4 716249.1 688596.6
2023 Q1 651898.4 624076.7
2023 Q2 697630.6 669739.3
2023 Q3 718720.2 690814.5
2023 Q4 734832.4 706926.5

$upper
             80%      95%
2018 Q1 617219.0 631403.9
2018 Q2 667173.4 685880.2
2018 Q3 689453.9 710548.2
2018 Q4 705542.1 727780.8
2019 Q1 644078.9 668627.1
2019 Q2 691281.3 716770.3
2019 Q3 713590.8 739301.7
2019 Q4 731491.3 757202.4
2020 Q1 669705.8 695641.5
2020 Q2 718225.5 744161.9
2020 Q3 742814.4 768879.2
2020 Q4 763329.2 789848.0
2021 Q1 702170.7 728693.8
2021 Q2 751265.2 777903.4
2021 Q3 775934.2 802881.4
2021 Q4 795752.7 823202.2
2022 Q1 733384.7 760834.8
2022 Q2 780796.9 808263.2
2022 Q3 803339.2 830869.8
2022 Q4 820722.5 848375.0
2023 Q1 757011.0 784832.6
2023 Q2 803006.3 830897.6
2023 Q3 824150.5 852056.3
2023 Q4 840263.2 868169.1