library(tidyverse)
library(DT) # visualizar a tablas
library(xts) # manipular series de tiempo
Problema 1
Importar la base de datos INPC como logarítmica, convertirla a serie de tiempo y graficarla (la serie comienza en enero de 1969). Descargue los datos de: https://www.inegi.org.mx/sistemas/bie/
inpc <- read_csv("Datos/BIE_T2.csv")
inpc_log <- inpc %>% mutate(valor_log = log(Valor))
datatable(inpc_log,options = list(pageLength = 12))
inpc_log_ts <- xts(inpc_log[,c("Valor","valor_log")],
order.by = seq(as.Date("1969-01-01"),length = nrow(inpc_log),
by = "month"))
plot(inpc_log_ts[,"valor_log"])
Problema 2
Problema 2a
Tomar una parte de la serie de tiempo que comience en enero 1969 y termine en Diciembre 2000, calcular sus tasas anuales y convertirla a serie de tiempo
parte1 <- inpc_log_ts["197001/200012","valor_log"]
parte1_lag <- inpc_log_ts["196901/199912","valor_log"]
yoy <- (as.numeric(parte1) - as.numeric(parte1_lag))*100
yoy <- xts(x = yoy, order.by = seq(as.Date("1970-01-01"), length =NROW(yoy), by = "month"))
plot(yoy)
Problema 2b
Tomar una parte de la serie de tiempo que comience en enero 2001 y termine en el año 2020, calcular sus tasas anuales y convertirla a serie de tiempo
parte2 <- inpc_log_ts["200201/202012","valor_log"]
parte2_lag <- inpc_log_ts["200101/201912","valor_log"]
yoy <- (as.numeric(parte2) - as.numeric(parte2_lag))*100
yoy <- xts(x = yoy, order.by = seq(as.Date("2002-01-01"), length =NROW(yoy), by = "month"))
plot(yoy)
Problema 2c
¿Por qué deberíamos de usar la segunda serie de tiempo (Ene 2001- Jun 2020)? Justificación económica. Ponerlo como comentario en R.
Existe bastante variación en el nivel de la tasas de la primer parte, en la decada de los 80’s y 90’s se titnen tasas de hasta 100 y 40 repectivamente. Mientras en la segunda parte de la serie, las tasas oscilan aproximadamente entre 1.5 y 7. Las comparaciones de tasas utilizando la primer parte de la serie contra datos en la segunda parte estarian sesgadas por los valores atípicos en la primer parte de la serie.
Problema 3
En un ciclo cambiar el año base de Julio 2018 a mayo 2020 (utilizando la serie de tiempo de Ene 2001-Jun 2020)
serieP2 <- inpc_log_ts["200101/202006","Valor"]
mayo2020 <-as.numeric(inpc_log_ts["202005","Valor"])
indice <- seq(as.Date("2001-01-01"), as.Date("2020-06-01"), by = "month")
for(i in indice){
fecha <- as.Date(i)
serieP2[fecha,"Valor"] <- serieP2[fecha,"Valor"]/mayo2020*100
}
Problema 3a
plot(serieP2)
Problema 3b
Vuelva la serie a logarítmica y calcule las tasas de crecimiento entre periodos
serieP2_log <- xts(log(as.numeric(serieP2$Valor)),
order.by = seq(as.Date("2001-01-01"), as.Date("2020-06-01"),
by = "month"))
MoM<-(as.numeric(serieP2_log)-lag(as.numeric(serieP2_log)))*100
MoM <- xts(x = MoM, order.by = seq(as.Date("2001-02-01"), length =NROW(MoM), by = "month"))
plot(MoM)
Problema 3c
Responda: ¿Qué tan distintas serían las tasas mensuales si se calcularán con la serie año base Julio 2018 y año base mayo 2020? Ponerlo como comentario en R
Al hacer las operaciones se tendría que tener las mismas tasas, es decir.
\[T_t = \ln(v_t*100/V_b)- \ln(v_{t-1}*100/V_b)=\ln(v_t)- \ln(v_{t-1})\]
Obsevamos que la diferencia es casi cero, salvo al aproximación computacional.
serie_log <- inpc_log_ts["200101/202006","valor_log"]
MoM1<-(as.numeric(serie_log)-lag(as.numeric(serie_log)))*100
MoM1 <- xts(x = MoM1, order.by =index(serie_log))
head(coredata(MoM1)-coredata(MoM))
## [,1]
## [1,] NA
## [2,] 4.440892e-14
## [3,] 0.000000e+00
## [4,] -4.440892e-14
## [5,] 0.000000e+00
## [6,] 0.000000e+00
Problema 3d
write.zoo(MoM,file="Datos/tasamensual_T2.csv", sep=",")
LS0tCnRpdGxlOiAiVGFyZWEgMiIKYXV0aG9yOiAiUmFmYWVsIE1hcnTDrW5leiBNYXJ0w61uZXoiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICAjbnVtYmVyX3NlY3Rpb25zOiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCiAgICBjb2RlX2ZvbGRpbmc6IHNob3cKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCBtZXNzYWdlID0gRkFMU0UsIHdhcm5pbmcgPSBGQUxTRSkKYGBgCgoKCmBgYHtyfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShEVCkgIyB2aXN1YWxpemFyIGEgdGFibGFzCmxpYnJhcnkoeHRzKSAjIG1hbmlwdWxhciBzZXJpZXMgZGUgdGllbXBvCmBgYAoKCiMgUHJvYmxlbWEgMQoKPGRpdiBpZCA9ICJqdXN0aWZpY2FyIj4KSW1wb3J0YXIgbGEgYmFzZSBkZSBkYXRvcyBJTlBDIGNvbW8gbG9nYXLDrXRtaWNhLCBjb252ZXJ0aXJsYSBhIHNlcmllIGRlIHRpZW1wbyB5IGdyYWZpY2FybGEgKGxhIHNlcmllIGNvbWllbnphIGVuIGVuZXJvIGRlIDE5NjkpLiBEZXNjYXJndWUgbG9zIGRhdG9zIGRlOiBodHRwczovL3d3dy5pbmVnaS5vcmcubXgvc2lzdGVtYXMvYmllLwo8L2Rpdj4KCgoKCmBgYHtyIHZhcl9lbnRyZV9lbW92aTIwMTd9CmlucGMgPC0gcmVhZF9jc3YoIkRhdG9zL0JJRV9UMi5jc3YiKQppbnBjX2xvZyA8LSBpbnBjICU+JSBtdXRhdGUodmFsb3JfbG9nID0gbG9nKFZhbG9yKSkKZGF0YXRhYmxlKGlucGNfbG9nLG9wdGlvbnMgPSBsaXN0KHBhZ2VMZW5ndGggPSAxMikpCmlucGNfbG9nX3RzIDwtIHh0cyhpbnBjX2xvZ1ssYygiVmFsb3IiLCJ2YWxvcl9sb2ciKV0sIAogICAgICAgICAgICAgICBvcmRlci5ieSA9IHNlcShhcy5EYXRlKCIxOTY5LTAxLTAxIiksbGVuZ3RoID0gbnJvdyhpbnBjX2xvZyksCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGJ5ID0gIm1vbnRoIikpCnBsb3QoaW5wY19sb2dfdHNbLCJ2YWxvcl9sb2ciXSkKYGBgCgojIFByb2JsZW1hIDIKCgoKCiMjIFByb2JsZW1hIDJhCgo8ZGl2IGlkID0gImp1c3RpZmljYXIiPgpUb21hciB1bmEgcGFydGUgZGUgbGEgc2VyaWUgZGUgdGllbXBvIHF1ZSBjb21pZW5jZSBlbiBlbmVybyAxOTY5IHkgdGVybWluZSBlbiBEaWNpZW1icmUgMjAwMCwgY2FsY3VsYXIgc3VzIHRhc2FzIGFudWFsZXMgeSBjb252ZXJ0aXJsYSBhIHNlcmllIGRlIHRpZW1wbwo8L2Rpdj4KCgpgYGB7cn0KcGFydGUxIDwtIGlucGNfbG9nX3RzWyIxOTcwMDEvMjAwMDEyIiwidmFsb3JfbG9nIl0KcGFydGUxX2xhZyA8LSBpbnBjX2xvZ190c1siMTk2OTAxLzE5OTkxMiIsInZhbG9yX2xvZyJdCgp5b3kgPC0gKGFzLm51bWVyaWMocGFydGUxKSAtIGFzLm51bWVyaWMocGFydGUxX2xhZykpKjEwMAp5b3kgPC0geHRzKHggPSB5b3ksIG9yZGVyLmJ5ID0gc2VxKGFzLkRhdGUoIjE5NzAtMDEtMDEiKSwgbGVuZ3RoID1OUk9XKHlveSksIGJ5ID0gIm1vbnRoIikpCnBsb3QoeW95KQpgYGAKCgojIyBQcm9ibGVtYSAyYgoKPGRpdiBpZCA9ICJqdXN0aWZpY2FyIj4KVG9tYXIgdW5hIHBhcnRlIGRlIGxhIHNlcmllIGRlIHRpZW1wbyBxdWUgY29taWVuY2UgZW4gZW5lcm8gMjAwMSB5IHRlcm1pbmUgZW4gZWwgYcOxbyAyMDIwLCBjYWxjdWxhciBzdXMgdGFzYXMgYW51YWxlcyB5IGNvbnZlcnRpcmxhIGEgc2VyaWUgZGUgdGllbXBvCjwvZGl2PgoKYGBge3J9CnBhcnRlMiA8LSBpbnBjX2xvZ190c1siMjAwMjAxLzIwMjAxMiIsInZhbG9yX2xvZyJdCnBhcnRlMl9sYWcgPC0gaW5wY19sb2dfdHNbIjIwMDEwMS8yMDE5MTIiLCJ2YWxvcl9sb2ciXQoKeW95IDwtIChhcy5udW1lcmljKHBhcnRlMikgLSBhcy5udW1lcmljKHBhcnRlMl9sYWcpKSoxMDAKeW95IDwtIHh0cyh4ID0geW95LCBvcmRlci5ieSA9IHNlcShhcy5EYXRlKCIyMDAyLTAxLTAxIiksIGxlbmd0aCA9TlJPVyh5b3kpLCBieSA9ICJtb250aCIpKQpwbG90KHlveSkKYGBgCgojIyBQcm9ibGVtYSAyYwoKPGRpdiBpZCA9ICJqdXN0aWZpY2FyIj4Kwr9Qb3IgcXXDqSBkZWJlcsOtYW1vcyBkZSB1c2FyIGxhIHNlZ3VuZGEgc2VyaWUgZGUgdGllbXBvIChFbmUgMjAwMS0gSnVuIDIwMjApPyBKdXN0aWZpY2FjacOzbiBlY29uw7NtaWNhLiBQb25lcmxvIGNvbW8gY29tZW50YXJpbyBlbiBSLgo8L2Rpdj4KCjxkaXYgaWQgPSAicmVzcHVlc3RhIj4KRXhpc3RlIGJhc3RhbnRlIHZhcmlhY2nDs24gZW4gZWwgbml2ZWwgZGUgbGEgdGFzYXMgZGUgbGEgcHJpbWVyIHBhcnRlLCBlbiBsYSBkZWNhZGEgZGUgbG9zIDgwJ3MgeSA5MCdzIHNlIHRpdG5lbiB0YXNhcyBkZSBoYXN0YSAxMDAgeSA0MCByZXBlY3RpdmFtZW50ZS4gTWllbnRyYXMgZW4gbGEgc2VndW5kYSBwYXJ0ZSBkZSBsYSBzZXJpZSwgIGxhcyB0YXNhcyBvc2NpbGFuIGFwcm94aW1hZGFtZW50ZSBlbnRyZSAxLjUgeSA3LiBMYXMgY29tcGFyYWNpb25lcyBkZSB0YXNhcyB1dGlsaXphbmRvIGxhIHByaW1lciBwYXJ0ZSBkZSBsYSBzZXJpZSBjb250cmEgZGF0b3MgZW4gbGEgc2VndW5kYSBwYXJ0ZSAgZXN0YXJpYW4gc2VzZ2FkYXMgcG9yIGxvcyB2YWxvcmVzIGF0w61waWNvcyBlbiBsYSBwcmltZXIgcGFydGUgZGUgbGEgc2VyaWUuICAKPC9kaXY+CgoKIyBQcm9ibGVtYSAzCgo8ZGl2IGlkID0gImp1c3RpZmljYXIiPgpFbiB1biBjaWNsbyBjYW1iaWFyIGVsIGHDsW8gYmFzZSBkZSBKdWxpbyAyMDE4IGEgbWF5byAyMDIwICh1dGlsaXphbmRvIGxhIHNlcmllIGRlIHRpZW1wbyBkZSBFbmUgMjAwMS1KdW4gMjAyMCkKPC9kaXY+CgoKYGBge3J9CnNlcmllUDIgPC0gaW5wY19sb2dfdHNbIjIwMDEwMS8yMDIwMDYiLCJWYWxvciJdCm1heW8yMDIwIDwtYXMubnVtZXJpYyhpbnBjX2xvZ190c1siMjAyMDA1IiwiVmFsb3IiXSkgCmluZGljZSA8LSBzZXEoYXMuRGF0ZSgiMjAwMS0wMS0wMSIpLCBhcy5EYXRlKCIyMDIwLTA2LTAxIiksIGJ5ID0gIm1vbnRoIikKZm9yKGkgaW4gaW5kaWNlKXsKICBmZWNoYSA8LSAgYXMuRGF0ZShpKQogIHNlcmllUDJbZmVjaGEsIlZhbG9yIl0gPC0gc2VyaWVQMltmZWNoYSwiVmFsb3IiXS9tYXlvMjAyMCoxMDAKfSAKYGBgCgoKIyMgUHJvYmxlbWEgM2EKCjxkaXYgaWQgPSAianVzdGlmaWNhciI+CkdyYWbDrXF1ZWxhCjwvZGl2PgoKYGBge3J9CnBsb3Qoc2VyaWVQMikKYGBgCgoKCiMjIFByb2JsZW1hIDNiCgo8ZGl2IGlkID0gImp1c3RpZmljYXIiPgpWdWVsdmEgbGEgc2VyaWUgYSBsb2dhcsOtdG1pY2EgeSBjYWxjdWxlIGxhcyB0YXNhcyBkZSBjcmVjaW1pZW50byBlbnRyZSBwZXJpb2Rvcwo8L2Rpdj4KCmBgYHtyfQpzZXJpZVAyX2xvZyA8LSB4dHMobG9nKGFzLm51bWVyaWMoc2VyaWVQMiRWYWxvcikpLAogICAgICAgICAgICAgICAgICAgb3JkZXIuYnkgPSBzZXEoYXMuRGF0ZSgiMjAwMS0wMS0wMSIpLCBhcy5EYXRlKCIyMDIwLTA2LTAxIiksCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBieSA9ICJtb250aCIpKSAKCgpNb008LShhcy5udW1lcmljKHNlcmllUDJfbG9nKS1sYWcoYXMubnVtZXJpYyhzZXJpZVAyX2xvZykpKSoxMDAKTW9NIDwtIHh0cyh4ID0gTW9NLCBvcmRlci5ieSA9IHNlcShhcy5EYXRlKCIyMDAxLTAyLTAxIiksIGxlbmd0aCA9TlJPVyhNb00pLCBieSA9ICJtb250aCIpKQpwbG90KE1vTSkKCmBgYAoKCiMjIFByb2JsZW1hIDNjCgo8ZGl2IGlkID0gImp1c3RpZmljYXIiPgpSZXNwb25kYTogwr9RdcOpIHRhbiBkaXN0aW50YXMgc2Vyw61hbiBsYXMgdGFzYXMgbWVuc3VhbGVzIHNpIHNlIGNhbGN1bGFyw6FuIGNvbiBsYQpzZXJpZSBhw7FvIGJhc2UgSnVsaW8gMjAxOCB5IGHDsW8gYmFzZSBtYXlvIDIwMjA/IFBvbmVybG8gY29tbyBjb21lbnRhcmlvIGVuClIKPC9kaXY+Cgo8ZGl2IGlkID0gInJlc3B1ZXN0YSI+CkFsIGhhY2VyIGxhcyBvcGVyYWNpb25lcyBzZSB0ZW5kcsOtYSBxdWUgdGVuZXIgbGFzIG1pc21hcyB0YXNhcywgZXMgZGVjaXIuCgokJFRfdCA9IFxsbih2X3QqMTAwL1ZfYiktIFxsbih2X3t0LTF9KjEwMC9WX2IpPVxsbih2X3QpLSBcbG4odl97dC0xfSkkJAoKT2JzZXZhbW9zIHF1ZSBsYSBkaWZlcmVuY2lhIGVzIGNhc2kgY2Vybywgc2Fsdm8gYWwgYXByb3hpbWFjacOzbiBjb21wdXRhY2lvbmFsLgoKPC9kaXY+CgpgYGB7cn0Kc2VyaWVfbG9nIDwtIGlucGNfbG9nX3RzWyIyMDAxMDEvMjAyMDA2IiwidmFsb3JfbG9nIl0KCk1vTTE8LShhcy5udW1lcmljKHNlcmllX2xvZyktbGFnKGFzLm51bWVyaWMoc2VyaWVfbG9nKSkpKjEwMApNb00xIDwtIHh0cyh4ID0gTW9NMSwgb3JkZXIuYnkgPWluZGV4KHNlcmllX2xvZykpCmhlYWQoY29yZWRhdGEoTW9NMSktY29yZWRhdGEoTW9NKSkKYGBgCgoKCgoKIyMgUHJvYmxlbWEgM2QKCjxkaXYgaWQgPSAianVzdGlmaWNhciI+CkV4cG9ydGEgbGEgeHRzIGEgY3N2CjwvZGl2PgoKYGBge3J9CndyaXRlLnpvbyhNb00sZmlsZT0iRGF0b3MvdGFzYW1lbnN1YWxfVDIuY3N2Iiwgc2VwPSIsIikKYGBgCgo=