Explicación en clase: Teoría y Ejemplo de Producción Trimestral (5 puntos)

Concepto

Una serie de tiempo es una colección de observaciones sobre un determinado fenómeno, efectuadas en momento sucesivos, usualmente esquiespaciados.

Algunos ejemplos de series de tiempo son:

  1. Precios de acciones

  2. Niveles de inventario

  3. Rotación de personal

  4. Ventas

  5. PIB(GDP)

Más información:

Libro R for Data Science (2e)

Instalar paquetes y llamar librerías

#install.packages("forecast")

library(forecast)

Crear la serie de tiempo

Ejemplo:

Los siguientes datos de producción trimestral inician en el primer trimestre de 2020.

Se busca pronosticar la producción de los siguientes 5 trimestres.

Produccion <- c(50,53,55,57,55,60)

ts <- ts(data=Produccion, start = c(2020,1), frequency = 4)
ts
##      Qtr1 Qtr2 Qtr3 Qtr4
## 2020   50   53   55   57
## 2021   55   60

Crear modelo ARIMA

ARIMA significa AutoRegressive Integrated Moving Average o Modelo Autoregresivo Integrado de Promedio Movil

arima <- auto.arima(ts, D=1)
arima
## Series: ts 
## ARIMA(0,0,0)(0,1,0)[4] with drift 
## 
## Coefficients:
##        drift
##       1.5000
## s.e.  0.1768
## 
## sigma^2 = 2.01:  log likelihood = -2.84
## AIC=9.68   AICc=-2.32   BIC=7.06
summary(arima)
## Series: ts 
## ARIMA(0,0,0)(0,1,0)[4] with drift 
## 
## Coefficients:
##        drift
##       1.5000
## s.e.  0.1768
## 
## sigma^2 = 2.01:  log likelihood = -2.84
## AIC=9.68   AICc=-2.32   BIC=7.06
## 
## Training set error measures:
##                      ME      RMSE       MAE        MPE      MAPE       MASE
## Training set 0.03333332 0.5787923 0.3666667 0.03685269 0.6429133 0.06111111
##                    ACF1
## Training set -0.5073047

Generar el pronostico

pronostico <- forecast(arima, level=c(95), h=5)
pronostico
##         Point Forecast    Lo 95    Hi 95
## 2021 Q3             61 58.22127 63.77873
## 2021 Q4             63 60.22127 65.77873
## 2022 Q1             61 58.22127 63.77873
## 2022 Q2             66 63.22127 68.77873
## 2022 Q3             67 63.07028 70.92972
plot(pronostico)

El modelo pronosticó que incrementará a 61 durante el 3er trimestre de 2021, luego subirá aún más durante el 4to trimestre (hasta 63), puego luego va a disminuir a 61 durante el 1er trimestre de 2022. Lo bueno es que se recupera de manera inmediata durante el 2do y 3er trimestre, alcanzando 66 y 67.

Actividad Hershey’s: Importar base de datos y crear serie de tiempo, modelo ARIMA y pronóstico (30 puntos, 10 c/u)

Importar base de datos

setwd("D:/8vo semestre")
library(readxl)
lechita <- read_xlsx("Ventas_Históricas_Lechitas.xlsx")
str(lechita)
## tibble [36 x 2] (S3: tbl_df/tbl/data.frame)
##  $ Mes   : POSIXct[1:36], format: "2017-01-01" "2017-02-01" ...
##  $ Ventas: num [1:36] 25521 23740 26254 25868 27073 ...

Crear la serie de tiempo

ts_1 <- ts(data=lechita$Ventas, start = c(2017,1), frequency = 12)
ts_1
##           Jan      Feb      Mar      Apr      May      Jun      Jul      Aug
## 2017 25520.51 23740.11 26253.58 25868.43 27072.87 27150.50 27067.10 28145.25
## 2018 28463.69 26996.11 29768.20 29292.51 29950.68 30099.17 30851.26 32271.76
## 2019 32496.44 31287.28 33376.02 32949.77 34004.11 33757.89 32927.30 34324.12
##           Sep      Oct      Nov      Dec
## 2017 27546.29 28400.37 27441.98 27852.47
## 2018 31940.74 32995.93 32197.12 31984.82
## 2019 35151.28 36133.07 34799.91 34846.17

Crear modelo ARIMA

arima_1 <- auto.arima(ts_1)
arima_1
## Series: ts_1 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8979
## s.e.  0.1551   0.2047   14.5026
## 
## sigma^2 = 202701:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72
summary(arima_1)
## Series: ts_1 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8979
## s.e.  0.1551   0.2047   14.5026
## 
## sigma^2 = 202701:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72
## 
## Training set error measures:
##                    ME    RMSE    MAE        MPE      MAPE       MASE      ACF1
## Training set 25.22158 343.864 227.17 0.08059932 0.7069542 0.06491044 0.2081026

Generar el pronostico

pronostico_1 <- forecast(arima_1, level=c(95), h=12)
pronostico_1
##          Point Forecast    Lo 95    Hi 95
## Jan 2020       35498.90 34616.48 36381.32
## Feb 2020       34202.17 33155.28 35249.05
## Mar 2020       36703.01 35596.10 37809.92
## Apr 2020       36271.90 35141.44 37402.36
## May 2020       37121.98 35982.07 38261.90
## Jun 2020       37102.65 35958.90 38246.40
## Jul 2020       37151.04 36005.73 38296.34
## Aug 2020       38564.64 37418.70 39710.58
## Sep 2020       38755.22 37609.03 39901.42
## Oct 2020       39779.02 38632.72 40925.32
## Nov 2020       38741.63 37595.28 39887.97
## Dec 2020       38645.86 37499.50 39792.22
plot(pronostico_1)

Los pronósticos muestran resultados turbulentos, claramente influenciados por el historial.

Los meses en los que hubo un incremento en comparación con el mes pasado fueron: Jan 20, Mar 20, May 20, Jul 20, Aug 20, Sep 20, y Oct 20

Los meses en los que hubo un decremento en comparación con el mes pasado fueron: Feb 20, Apr 20, Jun 20, Nov 20, Dec 20

Por lo tanto, los resultados fueron más positivos, ya que hubo más incrementos que decrementos.

Actividad Finanzas Corporativas: Información disponible: CompanyInfo, AnnualReports, GetIncome, etc. (5 puntos)

Llamar librería

#install.packages("finreportr")
library(finreportr)

Información disponible

Con la función finreportr podemos obtener la siguiente información:

  • CompanyInfo() = Brinda información general como Nombre, Ubicación, ZIP, etc.

  • AnnualReports() = Brinda el nombre, fecha y número de acceso.

  • GetIncome() = Brinda el Estado de Resultados.

  • GetBalanceSheet() = Brinda el Balance General.

  • GetCashFlow() = Brinda el Flujo de Efectivo.

Probar funciones

options(HTTPUserAgent = "a a@gmail.com")
CompanyInfo("JPM")
##               company        CIK  SIC state state.inc FY.end     street.address
## 1 JPMORGAN CHASE & CO 0000019617 6021    NY        DE   1231 383 MADISON AVENUE
##          city.state
## 1 NEW YORK NY 10017
AnnualReports("BABA", foreign = TRUE)
##    filing.name filing.date         accession.no
## 1       20-F/A  2024-02-23 0001193125-24-044480
## 2         20-F  2023-07-21 0000950170-23-033752
## 3         20-F  2022-07-26 0001104659-22-082622
## 4         20-F  2021-07-27 0001104659-21-096092
## 5         20-F  2020-07-09 0001104659-20-082409
## 6         20-F  2019-06-05 0001047469-19-003492
## 7         20-F  2018-07-27 0001047469-18-005257
## 8         20-F  2017-06-15 0001047469-17-004019
## 9         20-F  2016-05-24 0001047469-16-013400
## 10        20-F  2015-06-25 0001047469-15-005768
google_income <- GetIncome("GOOG",2016)
amazon_balance <- GetBalanceSheet("AMZN",2015)
apple_cash <- GetCashFlow("AAPL",2014) 
LS0tDQp0aXRsZTogIkFjdCBlbiBjbGFzZSBkaWEgNSBTZXJpZXMgZGUgdGllbXBvIg0KYXV0aG9yOiAiR3VpbGxlcm1vIEPDoXphcmVzIENydXoiDQpkYXRlOiAiMjAyNC0wMi0xNiINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KLS0tDQoNCiFbXShodHRwczovL21lZGlhLmdpcGh5LmNvbS9tZWRpYS8zb3JpZVZlNVZZcVRkVDE2cWsvZ2lwaHkuZ2lmP2NpZD03OTBiNzYxMTg1eWN6c3ViYnZuZmtoZW4zZ2kxNjN4ZGlhZHZyZnAzanI0cnczNWcmZXA9djFfZ2lmc19zZWFyY2gmcmlkPWdpcGh5LmdpZiZjdD1nKQ0KDQojIEV4cGxpY2FjacOzbiBlbiBjbGFzZTogVGVvcsOtYSB5IEVqZW1wbG8gZGUgUHJvZHVjY2nDs24gVHJpbWVzdHJhbCAgKDUgcHVudG9zKQ0KDQojIyBDb25jZXB0bw0KDQpVbmEgKipzZXJpZSBkZSB0aWVtcG8qKiBlcyB1bmEgY29sZWNjacOzbiBkZSBvYnNlcnZhY2lvbmVzIHNvYnJlIHVuIGRldGVybWluYWRvIGZlbsOzbWVubywgZWZlY3R1YWRhcyBlbiBtb21lbnRvIHN1Y2VzaXZvcywgdXN1YWxtZW50ZSBlc3F1aWVzcGFjaWFkb3MuICANCg0KQWxndW5vcyBlamVtcGxvcyBkZSBzZXJpZXMgZGUgdGllbXBvIHNvbjoNCg0KMS4gUHJlY2lvcyBkZSBhY2Npb25lcw0KDQoyLiBOaXZlbGVzIGRlIGludmVudGFyaW8NCg0KMy4gUm90YWNpw7NuIGRlIHBlcnNvbmFsDQoNCjQuIFZlbnRhcw0KDQo1LiBQSUIoKkdEUCopDQoNCk3DoXMgaW5mb3JtYWNpw7NuOg0KDQpbTGlicm8gKlIgZm9yIERhdGEgU2NpZW5jZSAoMmUpKl0oaHR0cHM6Ly9yNGRzLGhhZGxleS5uei8pDQoNCiMjIEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXMNCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCiNpbnN0YWxsLnBhY2thZ2VzKCJmb3JlY2FzdCIpDQoNCmxpYnJhcnkoZm9yZWNhc3QpDQpgYGANCg0KIyMgQ3JlYXIgbGEgc2VyaWUgZGUgdGllbXBvDQoNCioqRWplbXBsbzoqKg0KDQpMb3Mgc2lndWllbnRlcyBkYXRvcyBkZSBwcm9kdWNjacOzbiB0cmltZXN0cmFsIGluaWNpYW4gZW4gZWwgcHJpbWVyIHRyaW1lc3RyZSBkZSAyMDIwLiANCg0KU2UgYnVzY2EgcHJvbm9zdGljYXIgbGEgcHJvZHVjY2nDs24gZGUgbG9zIHNpZ3VpZW50ZXMgNSB0cmltZXN0cmVzLg0KDQpgYGB7cn0NClByb2R1Y2Npb24gPC0gYyg1MCw1Myw1NSw1Nyw1NSw2MCkNCg0KdHMgPC0gdHMoZGF0YT1Qcm9kdWNjaW9uLCBzdGFydCA9IGMoMjAyMCwxKSwgZnJlcXVlbmN5ID0gNCkNCnRzDQpgYGANCg0KIyMgQ3JlYXIgbW9kZWxvIEFSSU1BDQoNCioqQVJJTUEqKiBzaWduaWZpY2EgKkF1dG9SZWdyZXNzaXZlIEludGVncmF0ZWQgTW92aW5nIEF2ZXJhZ2UqIG8gTW9kZWxvIEF1dG9yZWdyZXNpdm8gSW50ZWdyYWRvIGRlIFByb21lZGlvIE1vdmlsDQoNCmBgYHtyfQ0KYXJpbWEgPC0gYXV0by5hcmltYSh0cywgRD0xKQ0KYXJpbWENCnN1bW1hcnkoYXJpbWEpDQpgYGANCg0KIyMgR2VuZXJhciBlbCBwcm9ub3N0aWNvDQoNCmBgYHtyfQ0KcHJvbm9zdGljbyA8LSBmb3JlY2FzdChhcmltYSwgbGV2ZWw9Yyg5NSksIGg9NSkNCnByb25vc3RpY28NCnBsb3QocHJvbm9zdGljbykNCmBgYA0KDQpFbCBtb2RlbG8gcHJvbm9zdGljw7MgcXVlIGluY3JlbWVudGFyw6EgYSA2MSBkdXJhbnRlIGVsIDNlciB0cmltZXN0cmUgZGUgMjAyMSwgbHVlZ28gc3ViaXLDoSBhw7puIG3DoXMgZHVyYW50ZSBlbCA0dG8gdHJpbWVzdHJlIChoYXN0YSA2MyksIHB1ZWdvIGx1ZWdvIHZhIGEgZGlzbWludWlyIGEgNjEgZHVyYW50ZSBlbCAxZXIgdHJpbWVzdHJlIGRlIDIwMjIuIExvIGJ1ZW5vIGVzIHF1ZSBzZSByZWN1cGVyYSBkZSBtYW5lcmEgaW5tZWRpYXRhIGR1cmFudGUgZWwgMmRvIHkgM2VyIHRyaW1lc3RyZSwgYWxjYW56YW5kbyA2NiB5IDY3Lg0KDQojIEFjdGl2aWRhZCBIZXJzaGV5J3M6IEltcG9ydGFyIGJhc2UgZGUgZGF0b3MgeSBjcmVhciBzZXJpZSBkZSB0aWVtcG8sIG1vZGVsbyBBUklNQSB5IHByb27Ds3N0aWNvICgzMCBwdW50b3MsIDEwIGMvdSkNCg0KIVtdKGh0dHBzOi8vbWVkaWEuZ2lwaHkuY29tL21lZGlhL2VyY1IydXhwam45Q2cvZ2lwaHkuZ2lmP2NpZD03OTBiNzYxMXpoazQ1MTRqNjZnbjhqcDRzNGp5emZudmthOHZ4dzNtdnB0NmE4ZDcmZXA9djFfZ2lmc19zZWFyY2gmcmlkPWdpcGh5LmdpZiZjdD1nKQ0KDQojIyBJbXBvcnRhciBiYXNlIGRlIGRhdG9zDQoNCmBgYHtyfQ0Kc2V0d2QoIkQ6Lzh2byBzZW1lc3RyZSIpDQpsaWJyYXJ5KHJlYWR4bCkNCmxlY2hpdGEgPC0gcmVhZF94bHN4KCJWZW50YXNfSGlzdMOzcmljYXNfTGVjaGl0YXMueGxzeCIpDQpgYGANCg0KYGBge3J9DQpzdHIobGVjaGl0YSkNCmBgYA0KDQojIyBDcmVhciBsYSBzZXJpZSBkZSB0aWVtcG8NCg0KYGBge3J9DQp0c18xIDwtIHRzKGRhdGE9bGVjaGl0YSRWZW50YXMsIHN0YXJ0ID0gYygyMDE3LDEpLCBmcmVxdWVuY3kgPSAxMikNCnRzXzENCmBgYA0KDQojIyBDcmVhciBtb2RlbG8gQVJJTUENCg0KYGBge3J9DQphcmltYV8xIDwtIGF1dG8uYXJpbWEodHNfMSkNCmFyaW1hXzENCnN1bW1hcnkoYXJpbWFfMSkNCmBgYA0KDQojIyBHZW5lcmFyIGVsIHByb25vc3RpY28NCg0KYGBge3J9DQpwcm9ub3N0aWNvXzEgPC0gZm9yZWNhc3QoYXJpbWFfMSwgbGV2ZWw9Yyg5NSksIGg9MTIpDQpwcm9ub3N0aWNvXzENCnBsb3QocHJvbm9zdGljb18xKQ0KYGBgDQoNCkxvcyBwcm9uw7NzdGljb3MgbXVlc3RyYW4gcmVzdWx0YWRvcyB0dXJidWxlbnRvcywgY2xhcmFtZW50ZSBpbmZsdWVuY2lhZG9zIHBvciBlbCBoaXN0b3JpYWwuIA0KDQpMb3MgbWVzZXMgZW4gbG9zIHF1ZSBodWJvIHVuIGluY3JlbWVudG8gZW4gY29tcGFyYWNpw7NuIGNvbiBlbCBtZXMgcGFzYWRvIGZ1ZXJvbjogSmFuIDIwLCBNYXIgMjAsIE1heSAyMCwgSnVsIDIwLCBBdWcgMjAsIFNlcCAyMCwgeSBPY3QgMjANCg0KTG9zIG1lc2VzIGVuIGxvcyBxdWUgaHVibyB1biBkZWNyZW1lbnRvIGVuIGNvbXBhcmFjacOzbiBjb24gZWwgbWVzIHBhc2FkbyBmdWVyb246IEZlYiAyMCwgQXByIDIwLCBKdW4gMjAsIE5vdiAyMCwgRGVjIDIwDQoNClBvciBsbyB0YW50bywgbG9zIHJlc3VsdGFkb3MgZnVlcm9uIG3DoXMgcG9zaXRpdm9zLCB5YSBxdWUgaHVibyBtw6FzIGluY3JlbWVudG9zIHF1ZSBkZWNyZW1lbnRvcy4NCg0KIyBBY3RpdmlkYWQgRmluYW56YXMgQ29ycG9yYXRpdmFzOiBJbmZvcm1hY2nDs24gZGlzcG9uaWJsZTogQ29tcGFueUluZm8sIEFubnVhbFJlcG9ydHMsIEdldEluY29tZSwgZXRjLiAoNSBwdW50b3MpDQoNCiFbXShodHRwczovL21lZGlhLmdpcGh5LmNvbS9tZWRpYS9sMEhsdnV2RFZCd1VjOGF3by9naXBoeS5naWY/Y2lkPTc5MGI3NjExOXI2dDBhNGg2M3l6Y2dybzBndzdlamQ1ZXEwczlvYmN3NTlwdzgzNiZlcD12MV9naWZzX3NlYXJjaCZyaWQ9Z2lwaHkuZ2lmJmN0PWcpDQoNCiMjIExsYW1hciBsaWJyZXLDrWENCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCiNpbnN0YWxsLnBhY2thZ2VzKCJmaW5yZXBvcnRyIikNCmxpYnJhcnkoZmlucmVwb3J0cikNCmBgYA0KDQojIyBJbmZvcm1hY2nDs24gZGlzcG9uaWJsZQ0KDQpDb24gbGEgZnVuY2nDs24gKmZpbnJlcG9ydHIqIHBvZGVtb3Mgb2J0ZW5lciBsYSBzaWd1aWVudGUgaW5mb3JtYWNpw7NuOg0KDQoqICpDb21wYW55SW5mbygpKiA9IEJyaW5kYSBpbmZvcm1hY2nDs24gZ2VuZXJhbCBjb21vIE5vbWJyZSwgVWJpY2FjacOzbiwgWklQLCBldGMuDQoNCiogKkFubnVhbFJlcG9ydHMoKSogPSBCcmluZGEgZWwgbm9tYnJlLCBmZWNoYSB5IG7Dum1lcm8gZGUgYWNjZXNvLg0KDQoqICpHZXRJbmNvbWUoKSogPSBCcmluZGEgZWwgRXN0YWRvIGRlIFJlc3VsdGFkb3MuDQoNCiogKkdldEJhbGFuY2VTaGVldCgpKiA9IEJyaW5kYSBlbCBCYWxhbmNlIEdlbmVyYWwuDQoNCiogKkdldENhc2hGbG93KCkqID0gQnJpbmRhIGVsIEZsdWpvIGRlIEVmZWN0aXZvLg0KDQojIyBQcm9iYXIgZnVuY2lvbmVzDQoNCmBgYHtyfQ0Kb3B0aW9ucyhIVFRQVXNlckFnZW50ID0gImEgYUBnbWFpbC5jb20iKQ0KQ29tcGFueUluZm8oIkpQTSIpDQpBbm51YWxSZXBvcnRzKCJCQUJBIiwgZm9yZWlnbiA9IFRSVUUpDQpnb29nbGVfaW5jb21lIDwtIEdldEluY29tZSgiR09PRyIsMjAxNikNCmFtYXpvbl9iYWxhbmNlIDwtIEdldEJhbGFuY2VTaGVldCgiQU1aTiIsMjAxNSkNCmFwcGxlX2Nhc2ggPC0gR2V0Q2FzaEZsb3coIkFBUEwiLDIwMTQpIA0KYGBgDQoNCg0KDQo=