- Económia verde: Proyección del PBI agropecuario con la serie agricola de la papa
- Carga de las siguientes librerias
- Creación de la función de extracción de datos del BCRP
- Resultados
- Extracción de la producción de la papa
- Gráfico dinámico
- Analisís de la serie temporal
Melissa Saenz
Maryori Dioses
David Rivera
Económia verde: Proyección del PBI agropecuario con la serie agricola de la papa
En el siguiente documento se presentara una proyección del PBI agropecuario con la serie agricola de la papa
Carga de las siguientes librerias
library(tidyverse)
library(data.table)
library(XML)
library(httr)
library(DT)
library(tseries)
library(highcharter)
library(forecast)
library(TSstudio)Cada libreria tienen sus siguientes funciones:
Las librerias tidyverse, data.table, XML y httr se utilizan para crear la función de extracción de datos medienate la tecnica de Web Scraping .
La libreria DT es para creación de cuadros dinámicos.
La libreria tseries posee muchas funciones para el analisis de series de tiempo.
La libreria higcharter es para la creación y ejecución de gráficas didacticas.
TSstduio posee varias funciones de analisis grafico de una manera iteractiva.
Forecast posee dos funciones vitales para este analisis las cuales son:
Auto.arima: función la cual nos permite llegar al modelo adecuado a traves de un algoritmo iterativo el cual toma al mejor modelo con el menor criterio de AIC.
Forecast: Permite hacer la proyección hacia el futuro.
Nota: El termino web scarping significa extracción de datos desde la misma pagina web, esto facilita muchos estudio.
Creación de la función de extracción de datos del BCRP
extraccion<- function(codigo=NULL,start=NULL,end=NULL){
vector<- vector()
datos<- NULL
for(i in 1:length(codigo)){
ex<- paste0("https://estadisticas.bcrp.gob.pe/estadisticas/series/api/",
codigo[i], "/xml/",start,"/",end)
ObjXML <- httr::GET(ex)
L_parseXML <- XML::xmlParse(ObjXML)
L_XML <- XML::xmlToList(L_parseXML)
dt_BCRP <- data.table::data.table()
for (a in 1:length(L_XML$periods)){
dt_temp <- data.table(
serie= L_XML$periods[[a]]$v)
dt_BCRP <- rbind(dt_BCRP,dt_temp)
}
vector[i]<- dt_BCRP[,serie:=as.numeric(serie)]
}
for(i in 1: length(codigo)){
datos<- cbind(datos,vector[[i]])
}
datos<- as.data.frame(datos)
names(datos)<- codigo
return(datos)
}Resultados
Extracción de la producción de la papa
ata<-extraccion("PN01777AM","2007-1","2020-12")
names(ata)<- "Producción de papa"
fecha<- as.Date("2007-01-01",format="%Y-%m-%d")
fecha<- seq(fecha,by="1 month",length=length(ata[,1]))
ata1<- cbind(fecha,round(ata,digits =3))
ata1%>% datatable(extensions = 'Buttons',
options = list(dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
lengthMenu = list(c(10,25,50,-1),
c(10,25,50,"All"))))Gráfico dinámico
Analisís de la serie temporal
Luego de tener una serie de tiempo de la producción de la papa pasamos a descomponerlo para poder observar la data, sus etapas, la tendencia y los residuos. Para luego poder gráficarlos y observarlo de una manera mas amigable y entretenida para el lector.
ts_decompose(ata)ts_seasonal(ata, type = "all")Ahora se procede a ejuctar la predicción de la serie de 12 periodos
modelo<- auto.arima(ata)Después de halla el modelo se procede hacer la proyección
proy<- forecast(ata,12)autoplot(ata, series="Data") +
autolayer(proy, series="Forecast") +
autolayer(fitted(proy), series="Fitted")+labs(title = "Proyección de la producción de la papa a un año")+
ylab("producción de papa")+theme_minimal()
LS0tDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6IA0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCiAgICAjIGNvZGVfZm9sZGluZzogaGlkZQ0KICAgIGhpZ2hsaWdodDogemVuYnVybg0KICAgICMgbnVtYmVyX3NlY3Rpb25zOiB5ZXMNCiAgICB0aGVtZTogImZsYXRseSINCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCi0tLQ0KDQpgYGB7ciBzZXR1cCxpbmNsdWRlPUZBTFNFfQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCB3YXJuaW5nID0gRkFMU0UsIG1lc3NhZ2UgPSBGQUxTRSwgY2FjaGUgPSBUUlVFKQ0KDQpgYGANCg0KPGNlbnRlcj4NCiFbXSh1bml2ZXJpZGFkLmpwZykNCjwvY2VudGVyPg0KPGNlbnRlcj4NCiAgICA8Yj5NZXRvZG9zIE7Dum1lcmljb3M8L2I+PGJyPg0KICAgIDxiPk1lbGlzc2EgU2Flbno8L2I+PGJyPg0KICAgIDxiPk1hcnlvcmkgRGlvc2VzPC9iPjxicj4NCiAgICA8Yj5EYXZpZCBSaXZlcmE8L2I+DQo8YnI+DQo8aDE+PHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPipfX0Vjb27Ds21pYSB2ZXJkZTogUHJveWVjY2nDs24gZGVsIFBCSSBhZ3JvcGVjdWFyaW8gY29uIGxhIHNlcmllIGFncmljb2xhIGRlIGxhIHBhcGEgX18qPC9zcGFuPjwvaDE+DQo8L2NlbnRlcj4NCjxjZW50ZXI+DQo8aT5DcmVhZG86ICAgICAxNi0wMi0yMDIxIA0KPC9jZW50ZXI+DQoNCkVuIGVsIHNpZ3VpZW50ZSBkb2N1bWVudG8gc2UgcHJlc2VudGFyYSB1bmEgcHJveWVjY2nDs24gZGVsICoqUEJJIGFncm9wZWN1YXJpbyoqIGNvbiBsYSBzZXJpZSBhZ3JpY29sYSBkZSBsYSBwYXBhDQoNCiFbXShTY3JlZW5zaG90XzEucG5nKQ0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4qX19DYXJnYSBkZSBsYXMgc2lndWllbnRlcyBsaWJyZXJpYXNfXyo8L3NwYW4+DQoNCmBgYHtyLHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShkYXRhLnRhYmxlKSANCmxpYnJhcnkoWE1MKQ0KbGlicmFyeShodHRyKQ0KbGlicmFyeShEVCkNCmxpYnJhcnkodHNlcmllcykNCmxpYnJhcnkoaGlnaGNoYXJ0ZXIpDQpsaWJyYXJ5KGZvcmVjYXN0KQ0KbGlicmFyeShUU3N0dWRpbykNCmBgYA0KDQpDYWRhIGxpYnJlcmlhIHRpZW5lbiBzdXMgc2lndWllbnRlcyBmdW5jaW9uZXM6IA0KDQoqIExhcyBsaWJyZXJpYXMgdGlkeXZlcnNlLCBkYXRhLnRhYmxlLCBYTUwgeSBodHRyIHNlIHV0aWxpemFuIHBhcmEgY3JlYXIgbGEgZnVuY2nDs24gZGUgZXh0cmFjY2nDs24gZGUgZGF0b3MgbWVkaWVuYXRlIGxhIHRlY25pY2EgZGUgKipXZWIgU2NyYXBpbmcqKiAuIA0KDQoqIExhIGxpYnJlcmlhIERUIGVzIHBhcmEgY3JlYWNpw7NuIGRlIGN1YWRyb3MgZGluw6FtaWNvcy4gDQoNCiogTGEgbGlicmVyaWEgdHNlcmllcyBwb3NlZSBtdWNoYXMgZnVuY2lvbmVzIHBhcmEgZWwgYW5hbGlzaXMgZGUgc2VyaWVzIGRlIHRpZW1wby4gDQoNCiogTGEgbGlicmVyaWEgaGlnY2hhcnRlciBlcyBwYXJhIGxhIGNyZWFjacOzbiB5IGVqZWN1Y2nDs24gZGUgZ3LDoWZpY2FzIGRpZGFjdGljYXMuIA0KDQoqIFRTc3RkdWlvIHBvc2VlIHZhcmlhcyBmdW5jaW9uZXMgZGUgYW5hbGlzaXMgZ3JhZmljbyBkZSB1bmEgbWFuZXJhIGl0ZXJhY3RpdmEuIA0KDQoqIEZvcmVjYXN0IHBvc2VlIGRvcyBmdW5jaW9uZXMgdml0YWxlcyBwYXJhIGVzdGUgYW5hbGlzaXMgbGFzIGN1YWxlcyBzb246IA0KDQogIC0gQXV0by5hcmltYTogZnVuY2nDs24gbGEgY3VhbCBub3MgcGVybWl0ZSBsbGVnYXIgYWwgbW9kZWxvIGFkZWN1YWRvIGEgICAgICAgIHRyYXZlcyAgICAgZGUgdW4gYWxnb3JpdG1vIGl0ZXJhdGl2byBlbCBjdWFsIHRvbWEgYWwgbWVqb3IgbW9kZWxvIGNvbiBlbCAgICAgbWVub3IgICAgICAgICBjcml0ZXJpbyBkZSAqKkFJQyoqLiANCiAgDQogICAtIEZvcmVjYXN0OiBQZXJtaXRlIGhhY2VyIGxhIHByb3llY2Npw7NuIGhhY2lhIGVsIGZ1dHVyby4gDQogDQo+IE5vdGE6IEVsIHRlcm1pbm8gd2ViIHNjYXJwaW5nIHNpZ25pZmljYSBleHRyYWNjacOzbiBkZSBkYXRvcyBkZXNkZSBsYSBtaXNtYSBwYWdpbmEgd2ViLCBlc3RvIGZhY2lsaXRhIG11Y2hvcyBlc3R1ZGlvLiANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+Kl9fQ3JlYWNpw7NuIGRlIGxhIGZ1bmNpw7NuIGRlIGV4dHJhY2Npw7NuIGRlIGRhdG9zIGRlbCBCQ1JQX18qPC9zcGFuPg0KDQpgYGB7cn0NCmV4dHJhY2Npb248LSBmdW5jdGlvbihjb2RpZ289TlVMTCxzdGFydD1OVUxMLGVuZD1OVUxMKXsNCiAgdmVjdG9yPC0gdmVjdG9yKCkNCiAgZGF0b3M8LSBOVUxMDQogIGZvcihpIGluIDE6bGVuZ3RoKGNvZGlnbykpew0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGV4PC0gIHBhc3RlMCgiaHR0cHM6Ly9lc3RhZGlzdGljYXMuYmNycC5nb2IucGUvZXN0YWRpc3RpY2FzL3Nlcmllcy9hcGkvIiwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY29kaWdvW2ldLCAiL3htbC8iLHN0YXJ0LCIvIixlbmQpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgDQogIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIE9ialhNTCA8LSBodHRyOjpHRVQoZXgpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgTF9wYXJzZVhNTCA8LSBYTUw6OnhtbFBhcnNlKE9ialhNTCkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIExfWE1MIDwtIFhNTDo6eG1sVG9MaXN0KExfcGFyc2VYTUwpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZHRfQkNSUCA8LSBkYXRhLnRhYmxlOjpkYXRhLnRhYmxlKCkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBmb3IgKGEgaW4gMTpsZW5ndGgoTF9YTUwkcGVyaW9kcykpew0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGR0X3RlbXAgPC0gZGF0YS50YWJsZSgNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2VyaWU9IExfWE1MJHBlcmlvZHNbW2FdXSR2KQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGR0X0JDUlAgPC0gcmJpbmQoZHRfQkNSUCxkdF90ZW1wKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIH0NCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2ZWN0b3JbaV08LSBkdF9CQ1JQWyxzZXJpZTo9YXMubnVtZXJpYyhzZXJpZSldIA0KICB9DQogIGZvcihpIGluICAxOiBsZW5ndGgoY29kaWdvKSl7DQogICAgZGF0b3M8LSBjYmluZChkYXRvcyx2ZWN0b3JbW2ldXSkNCiAgfQ0KICBkYXRvczwtIGFzLmRhdGEuZnJhbWUoZGF0b3MpDQogIG5hbWVzKGRhdG9zKTwtIGNvZGlnbw0KICByZXR1cm4oZGF0b3MpDQogIH0NCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+Kl9fUmVzdWx0YWRvc19fKjwvc3Bhbj4gDQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+Kl9fRXh0cmFjY2nDs24gZGUgbGEgcHJvZHVjY2nDs24gZGUgbGEgcGFwYV9fKjwvc3Bhbj4NCg0KYGBge3Isd2FybmluZz1GQUxTRSxtZXNzYWdlPUZBTFNFfQ0KYXRhPC1leHRyYWNjaW9uKCJQTjAxNzc3QU0iLCIyMDA3LTEiLCIyMDIwLTEyIikNCm5hbWVzKGF0YSk8LSAiUHJvZHVjY2nDs24gZGUgcGFwYSINCmZlY2hhPC0gYXMuRGF0ZSgiMjAwNy0wMS0wMSIsZm9ybWF0PSIlWS0lbS0lZCIpDQpmZWNoYTwtIHNlcShmZWNoYSxieT0iMSBtb250aCIsbGVuZ3RoPWxlbmd0aChhdGFbLDFdKSkNCmF0YTE8LSBjYmluZChmZWNoYSxyb3VuZChhdGEsZGlnaXRzID0zKSkNCmF0YTElPiUgZGF0YXRhYmxlKGV4dGVuc2lvbnMgPSAnQnV0dG9ucycsDQogICAgICAgICAgICBvcHRpb25zID0gbGlzdChkb20gPSAnQmxmcnRpcCcsDQogICAgICAgICAgICAgICAgICAgICAgICAgICBidXR0b25zID0gYygnY29weScsICdjc3YnLCAnZXhjZWwnLCAncGRmJywgJ3ByaW50JyksDQogICAgICAgICAgICAgICAgICAgICAgICAgICBsZW5ndGhNZW51ID0gbGlzdChjKDEwLDI1LDUwLC0xKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGMoMTAsMjUsNTAsIkFsbCIpKSkpDQpgYGANCg0KIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4qX19HcsOhZmljbyBkaW7DoW1pY29fXyo8L3NwYW4+ICANCg0KYGBge3IsZWNobz1GQUxTRSxtZXNzYWdlPUZBTFNFLHdhcm5pbmc9RkFMU0V9DQphdGEgPC0gdHMoYXRhLHN0YXJ0ID0gYygyMDA3LDAxKSxmcmVxdWVuY3kgPSAxMikNCmhpZ2hjaGFydCh0eXBlID0gInN0b2NrIikgJT4lIA0KICBoY19hZGRfc2VyaWVzKGF0YSxjb2xvcj0iYmx1ZSIsdHlwZT0ibGluZSIpICU+JSBoY19hZGRfdGhlbWUoaGNfdGhlbWVfZWNvbm9taXN0KCkpICU+JSANCiAgaGNfdGl0bGUodGV4dCA9ICJQcm9kdWNjacOzbiBkZSBsYSBwYXBhIiwNCiAgICAgICAgICAgICBzdHlsZSA9IGxpc3QoZm9udFdlaWdodCA9ICJib2xkIiwgZm9udFNpemUgPSAiMjBweCIpLA0KICAgICAgICAgICAgIGFsaWduID0gImNlbnRlciIpICU+JSANCiAgIGhjX2NyZWRpdHMoZW5hYmxlZCA9IFRSVUUsdGV4dCA9ICJGdWVudGUgQkNSUCAiKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPipfX0FuYWxpc8OtcyBkZSBsYSBzZXJpZSB0ZW1wb3JhbF9fKjwvc3Bhbj4NCg0KTHVlZ28gZGUgdGVuZXIgdW5hIHNlcmllIGRlIHRpZW1wbyBkZSBsYSBwcm9kdWNjacOzbiBkZSBsYSBwYXBhIHBhc2Ftb3MgYSBkZXNjb21wb25lcmxvIHBhcmEgcG9kZXIgb2JzZXJ2YXIgbGEgZGF0YSwgc3VzIGV0YXBhcywgbGEgdGVuZGVuY2lhIHkgbG9zIHJlc2lkdW9zLiBQYXJhIGx1ZWdvIHBvZGVyIGdyw6FmaWNhcmxvcyB5IG9ic2VydmFybG8gZGUgdW5hIG1hbmVyYSBtYXMgYW1pZ2FibGUgeSBlbnRyZXRlbmlkYSBwYXJhIGVsIGxlY3Rvci4NCg0KYGBge3J9DQp0c19kZWNvbXBvc2UoYXRhKQ0KYGBgDQoNCmBgYHtyfQ0KdHNfc2Vhc29uYWwoYXRhLCB0eXBlID0gImFsbCIpDQpgYGANCg0KQWhvcmEgc2UgcHJvY2VkZSBhIGVqdWN0YXIgbGEgcHJlZGljY2nDs24gZGUgbGEgc2VyaWUgZGUgMTIgcGVyaW9kb3MNCg0KYGBge3J9DQptb2RlbG88LSBhdXRvLmFyaW1hKGF0YSkNCmBgYA0KDQpEZXNwdcOpcyBkZSBoYWxsYSBlbCBtb2RlbG8gc2UgcHJvY2VkZSBoYWNlciBsYSBwcm95ZWNjacOzbg0KDQpgYGB7cn0NCnByb3k8LSBmb3JlY2FzdChhdGEsMTIpDQpgYGANCg0KYGBge3J9DQphdXRvcGxvdChhdGEsIHNlcmllcz0iRGF0YSIpICsNCiAgYXV0b2xheWVyKHByb3ksIHNlcmllcz0iRm9yZWNhc3QiKSArDQogIGF1dG9sYXllcihmaXR0ZWQocHJveSksIHNlcmllcz0iRml0dGVkIikrbGFicyh0aXRsZSA9ICJQcm95ZWNjacOzbiBkZSBsYSBwcm9kdWNjacOzbiBkZSBsYSBwYXBhIGEgdW4gYcOxbyIpKw0KICB5bGFiKCJwcm9kdWNjacOzbiBkZSBwYXBhIikrdGhlbWVfbWluaW1hbCgpDQpgYGANCg0K