Ejercicio en clase

Concepto

Una serie de tiempo es una colección de observaciones sobre un dererminado fenómeno, efectuadas en momentos sucesivos, usualmente equiespaciados.

Algunos ejemplos de series de tiempo son:
1. Precio de acciones
2. Niveles de inventario
3. Rotación de personal
4. Ventas
5. PIB (“GDP”)

Libro | R for Data Science (2e)

Preparación del entorno

Instalación de paquetes

# install.packages("forecast")

Llamar a las librerías

library(forecast)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

Crear la serie de tiempo

Ejemplo Los siguientes datos de producción trimestral inician en el primer trimestre de 2020.
Se Busca pornosticar 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)
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

Genera el pronóstico

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

Genera la gráfica

plot(pronostico)

Actividad 2 - Hershey’s

Crear la serie de tiempo

lechita <- read.csv("Ventas_Historicas_Lechitas.csv")
  
ts1 <- ts(data=lechita$Ventas, start = c(2017,1), frequency = 12)
ts1
##           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 significa Autoregressive Integrated Moving Average o Modelo Autoregresivo Integrado de Promedio Movil.

arima1 <- auto.arima(ts1, D = 1)
summary(arima1)
## Series: ts1 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8980
## s.e.  0.1551   0.2047   14.5025
## 
## sigma^2 = 202700:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72
## 
## Training set error measures:
##                    ME    RMSE      MAE        MPE      MAPE       MASE
## Training set 25.22163 343.863 227.1699 0.08059942 0.7069541 0.06491041
##                   ACF1
## Training set 0.2081043

Genera el pronóstico

pronostico <- forecast(arima1, level = c(95), h = 12)
pronostico
##          Point Forecast    Lo 95    Hi 95
## Jan 2020       35498.90 34616.48 36381.32
## Feb 2020       34202.17 33155.29 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.91 38246.40
## Jul 2020       37151.04 36005.74 38296.35
## Aug 2020       38564.65 37418.71 39710.59
## Sep 2020       38755.23 37609.03 39901.42
## Oct 2020       39779.03 38632.73 40925.33
## Nov 2020       38741.63 37595.29 39887.97
## Dec 2020       38645.86 37499.50 39792.22

Generar la Gráfica

plot(pronostico)

Actividad 3 - Finanzas corporativas

Preparación del entorno

Intalar paquetes

# install.packages("finreportr")

Cargar librerias

library(finreportr)

Información diponible

Con la función finreportr podemos oberner 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
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)

Análisis Financiero de Tesla: Analisis de ingresos

Preparación de los datos

options(HTTPUserAgent = "a a@gmail.com")
a <- GetIncome("TSLA", 2018)
b <- GetIncome("TSLA", 2015)
c <- GetIncome("TSLA", 2013)
d <- GetIncome("TSLA", 2012)

e <- rbind(a,b)
e <- rbind(e,c)
e <- rbind(e,d)

e$Amount <- as.numeric(e$Amount)
e$startDate <- as.Date(e$startDate, "%Y-%m-%d")
e$endDate <- as.Date(e$endDate, "%Y-%m-%d")
e <- e %>% 
  mutate(date_diff = ((startDate %--% endDate)/days(1)))

TSLA_trim <- e %>% 
  filter(Metric == "Revenues" & date_diff < 364)

TSLA_year <- e %>% 
  filter(Metric == "Revenues" & date_diff >= 364)

TSLA_trim <- TSLA_trim %>% 
  select(Amount, endDate) %>% 
  mutate(Amount = Amount/1000000000) %>% 
  arrange(endDate)

TSLA_trim <- unique(e, by = "endDate")

TSLA_year <- TSLA_year %>% 
  select(Amount, endDate) %>% 
  mutate(Amount = Amount/1000000000) %>% 
  arrange(endDate)

Analisis Anual

ts <- ts(data=TSLA_trim$Amount, start = c(2009), frequency = 1)
arima <- auto.arima(ts)
pronostico <- forecast(arima, level = c(95), h = 5)

plot(pronostico, main = "Pronostico Ventas Anuales Tesla (en billones)")

Analisis Trtimestral

ts <- ts(data=TSLA_year$Amount, start = c(2011,1), frequency = 4)
arima <- auto.arima(ts)
pronostico <- forecast(arima, level = c(95), h = 8)

plot(pronostico, main = "Pronostico Ventas Trimestrales Tesla (en billones)")

LS0tCnRpdGxlOiAiU2VyaWVzIGRlIFRpZW1wbyIKYXV0aG9yOiAiSmVzw7pzIFV6aWVsIENhcmRlbGFzIFDDqXJleiAtIEExMDc0NjA1MCIKZGF0ZTogIjIwMjQtMDItMTYiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgbnVtYmVyX3NlY3Rpb25zOiBmYWxzZQogICAgdG9jOiB0cnVlCiAgICB0b2NfZGVwdGg6IDQKICAgIHRvY19mbG9hdDoKICAgICAgY29sbGFwc2VkOiB0cnVlCiAgICAgIHNtb290aF9zY3JvbGw6IHRydWUKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKICBwZGZfZG9jdW1lbnQ6CiAgICB0b2M6IHRydWUKICAgIHRvY19kZXB0aDogJzQnCi0tLQoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkKYGBgCgojIEVqZXJjaWNpbyBlbiBjbGFzZQohW10oaHR0cHM6Ly9taXJvLm1lZGl1bS5jb20vdjIvcmVzaXplOmZpdDoxNDAwL2Zvcm1hdDp3ZWJwLzEqTnBFT2cwSjJCcDBRWnRxb3FuZjQ3QS5naWYpCgojIyBDb25jZXB0bwpVbmEgKipzZXJpZSBkZSB0aWVtcG8qKiBlcyB1bmEgY29sZWNjacOzbiBkZSBvYnNlcnZhY2lvbmVzIHNvYnJlIHVuIGRlcmVybWluYWRvIGZlbsOzbWVubywgZWZlY3R1YWRhcyBlbiBtb21lbnRvcyBzdWNlc2l2b3MsIHVzdWFsbWVudGUgZXF1aWVzcGFjaWFkb3MuICAKCkFsZ3Vub3MgZWplbXBsb3MgZGUgc2VyaWVzIGRlIHRpZW1wbyBzb246ICAKMS4gUHJlY2lvIGRlIGFjY2lvbmVzICAKMi4gTml2ZWxlcyBkZSBpbnZlbnRhcmlvICAKMy4gUm90YWNpw7NuIGRlIHBlcnNvbmFsICAKNC4gVmVudGFzICAKNS4gUElCICgiR0RQIikgIAoKW0xpYnJvIHwgUiBmb3IgRGF0YSBTY2llbmNlICgyZSldKGh0dHBzOi8vcjRkcy5oYWRsZXkubnopCgojIyBQcmVwYXJhY2nDs24gZGVsIGVudG9ybm8KIyMjIEluc3RhbGFjacOzbiBkZSBwYXF1ZXRlcwpgYGB7cn0KIyBpbnN0YWxsLnBhY2thZ2VzKCJmb3JlY2FzdCIpCmBgYAoKIyMjIExsYW1hciBhIGxhcyBsaWJyZXLDrWFzCmBgYHtyfQpsaWJyYXJ5KGZvcmVjYXN0KQpgYGAKCiMjIENyZWFyIGxhIHNlcmllIGRlIHRpZW1wbwoqKkVqZW1wbG8qKgpMb3Mgc2lndWllbnRlcyBkYXRvcyBkZSBwcm9kdWNjacOzbiB0cmltZXN0cmFsICBpbmljaWFuIGVuIGVsIHByaW1lciB0cmltZXN0cmUgZGUgMjAyMC4gIApTZSBCdXNjYSBwb3Jub3N0aWNhciBsYSBwcm9kdWNjacOzbiBkZSBsb3Mgc2lndWllbnRlcyA1IHRyaW1lc3RyZXMuCgpgYGB7cn0KcHJvZHVjY2lvbiA8LSBjKDUwLDUzLDU1LDU3LDU1LDYwKQoKdHMgPC0gdHMoZGF0YT1wcm9kdWNjaW9uLCBzdGFydCA9IGMoMjAyMCwxKSwgZnJlcXVlbmN5ID0gNCkKdHMKYGBgCgojIyBDcmVhciBtb2RlbG8gQVJJTUEKKipBUklNQSoqIHNpZ25pZmljYSAqQXV0b3JlZ3Jlc3NpdmUgSW50ZWdyYXRlZCBNb3ZpbmcgQXZlcmFnZSogbyBNb2RlbG8gQXV0b3JlZ3Jlc2l2byBJbnRlZ3JhZG8gZGUgUHJvbWVkaW8gTW92aWwuICAKCmBgYHtyfQphcmltYSA8LSBhdXRvLmFyaW1hKHRzLCBEID0gMSkKc3VtbWFyeShhcmltYSkKYGBgCgojIyBHZW5lcmEgZWwgcHJvbsOzc3RpY28KYGBge3J9CnByb25vc3RpY28gPC0gZm9yZWNhc3QoYXJpbWEsIGxldmVsID0gYyg5NSksIGggPSA1KQpwcm9ub3N0aWNvCmBgYAojIyBHZW5lcmEgbGEgZ3LDoWZpY2EKYGBge3J9CnBsb3QocHJvbm9zdGljbykKYGBgCgojIEFjdGl2aWRhZCAyIC0gSGVyc2hleSdzCiFbXShodHRwczovL21lZGlhMS5naXBoeS5jb20vYXZhdGFycy9IQ1dTb2NpYWwvZnRJTWRvelBJTGRsLmdpZikKCiMjIENyZWFyIGxhIHNlcmllIGRlIHRpZW1wbwpgYGB7cn0KbGVjaGl0YSA8LSByZWFkLmNzdigiVmVudGFzX0hpc3RvcmljYXNfTGVjaGl0YXMuY3N2IikKICAKdHMxIDwtIHRzKGRhdGE9bGVjaGl0YSRWZW50YXMsIHN0YXJ0ID0gYygyMDE3LDEpLCBmcmVxdWVuY3kgPSAxMikKdHMxCmBgYAoKIyMgQ3JlYXIgbW9kZWxvIEFSSU1BCioqQVJJTUEqKiBzaWduaWZpY2EgKkF1dG9yZWdyZXNzaXZlIEludGVncmF0ZWQgTW92aW5nIEF2ZXJhZ2UqIG8gTW9kZWxvIEF1dG9yZWdyZXNpdm8gSW50ZWdyYWRvIGRlIFByb21lZGlvIE1vdmlsLiAgCgpgYGB7cn0KYXJpbWExIDwtIGF1dG8uYXJpbWEodHMxLCBEID0gMSkKc3VtbWFyeShhcmltYTEpCmBgYAoKIyMgR2VuZXJhIGVsIHByb27Ds3N0aWNvCmBgYHtyfQpwcm9ub3N0aWNvIDwtIGZvcmVjYXN0KGFyaW1hMSwgbGV2ZWwgPSBjKDk1KSwgaCA9IDEyKQpwcm9ub3N0aWNvCmBgYAoKIyMgR2VuZXJhciBsYSBHcsOhZmljYQpgYGB7cn0KcGxvdChwcm9ub3N0aWNvKQpgYGAKCiMgQWN0aXZpZGFkIDMgLSBGaW5hbnphcyBjb3Jwb3JhdGl2YXMKIVtdKGh0dHBzOi8vZWxjZW8uY29tL3dwLWNvbnRlbnQvdXBsb2Fkcy8yMDIzLzExL3dhbGxfc3QtMy0xLmpwZykKCiMjIFByZXBhcmFjacOzbiBkZWwgZW50b3JubwoKIyMjIEludGFsYXIgcGFxdWV0ZXMKYGBge3J9CiMgaW5zdGFsbC5wYWNrYWdlcygiZmlucmVwb3J0ciIpCmBgYAoKIyMjIENhcmdhciBsaWJyZXJpYXMKYGBge3J9CmxpYnJhcnkoZmlucmVwb3J0cikKYGBgCgojIyBJbmZvcm1hY2nDs24gZGlwb25pYmxlCkNvbiBsYSBmdW5jacOzbiAqZmlucmVwb3J0ciogcG9kZW1vcyBvYmVybmVyIGxhIHNpZ3VpZW50ZSBpbmZvcm1hY2nDs246ICAKICAKICAqIENvbXBhbnlJbmZvKCApID0gQnJpbmRhIGluZm9ybWFjacOzbiBnZW5lcmFsIGNvbW8gTm9tYnJlLCBVYmljYWNpw7NuLCBaSVAsIGV0Yy4gIAogICogQW5udWFsUmVwb3J0cyggKSA9IEJyaW5kYSBlbCBub21icmUsIGZlY2hhIHkgbsO6bWVybyBkZSBhY2Nlc28uICAKICAqIEdldEluY29tZSggKSA9IEJyaW5kYSBlbCBFc3RhZG8gZGUgUmVzdWx0YWRvcy4gIAogICogR2V0QmFsYW5jZVNoZWV0KCApID0gQnJpbmRhIGVsIEJhbGFuY2UgR2VuZXJhbC4gIAogICogR2V0Q2FzaEZsb3coICkgPSBCcmluZGEgZWwgRmx1am8gZGUgRWZlY3Rpdm8KCmBgYHtyLCBtZXNzYWdlPUZBTFNFfQpvcHRpb25zKEhUVFBVc2VyQWdlbnQgPSAiYSBhQGdtYWlsLmNvbSIpCkNvbXBhbnlJbmZvKCJKUE0iKQpBbm51YWxSZXBvcnRzKCJCQUJBIiwgZm9yZWlnbiA9IFRSVUUpCiMgZ29vZ2xlX2luY29tZSA8LSBHZXRJbmNvbWUoIkdPT0ciLCAyMDE2KQojIGFtYXpvbl9iYWxhbmNlIDwtIEdldEJhbGFuY2VTaGVldCgiQU1aTiIsIDIwMTUpCiMgYXBwbGVfY2FzaCA8LSBHZXRDYXNoRmxvdygiQUFQTCIsIDIwMTQpCmBgYAoKCiMgQW7DoWxpc2lzIEZpbmFuY2llcm8gZGUgVGVzbGE6IEFuYWxpc2lzIGRlIGluZ3Jlc29zCgojIyBQcmVwYXJhY2nDs24gZGUgbG9zIGRhdG9zCmBgYHtyLCBldmFsPUZBTFNFfQpvcHRpb25zKEhUVFBVc2VyQWdlbnQgPSAiYSBhQGdtYWlsLmNvbSIpCmEgPC0gR2V0SW5jb21lKCJUU0xBIiwgMjAxOCkKYiA8LSBHZXRJbmNvbWUoIlRTTEEiLCAyMDE1KQpjIDwtIEdldEluY29tZSgiVFNMQSIsIDIwMTMpCmQgPC0gR2V0SW5jb21lKCJUU0xBIiwgMjAxMikKCmUgPC0gcmJpbmQoYSxiKQplIDwtIHJiaW5kKGUsYykKZSA8LSByYmluZChlLGQpCgplJEFtb3VudCA8LSBhcy5udW1lcmljKGUkQW1vdW50KQplJHN0YXJ0RGF0ZSA8LSBhcy5EYXRlKGUkc3RhcnREYXRlLCAiJVktJW0tJWQiKQplJGVuZERhdGUgPC0gYXMuRGF0ZShlJGVuZERhdGUsICIlWS0lbS0lZCIpCmUgPC0gZSAlPiUgCiAgbXV0YXRlKGRhdGVfZGlmZiA9ICgoc3RhcnREYXRlICUtLSUgZW5kRGF0ZSkvZGF5cygxKSkpCgpUU0xBX3RyaW0gPC0gZSAlPiUgCiAgZmlsdGVyKE1ldHJpYyA9PSAiUmV2ZW51ZXMiICYgZGF0ZV9kaWZmIDwgMzY0KQoKVFNMQV95ZWFyIDwtIGUgJT4lIAogIGZpbHRlcihNZXRyaWMgPT0gIlJldmVudWVzIiAmIGRhdGVfZGlmZiA+PSAzNjQpCgpUU0xBX3RyaW0gPC0gVFNMQV90cmltICU+JSAKICBzZWxlY3QoQW1vdW50LCBlbmREYXRlKSAlPiUgCiAgbXV0YXRlKEFtb3VudCA9IEFtb3VudC8xMDAwMDAwMDAwKSAlPiUgCiAgYXJyYW5nZShlbmREYXRlKQoKVFNMQV90cmltIDwtIHVuaXF1ZShlLCBieSA9ICJlbmREYXRlIikKClRTTEFfeWVhciA8LSBUU0xBX3llYXIgJT4lIAogIHNlbGVjdChBbW91bnQsIGVuZERhdGUpICU+JSAKICBtdXRhdGUoQW1vdW50ID0gQW1vdW50LzEwMDAwMDAwMDApICU+JSAKICBhcnJhbmdlKGVuZERhdGUpCmBgYAoKIyMgQW5hbGlzaXMgQW51YWwKYGBge3IsIGV2YWw9RkFMU0V9CnRzIDwtIHRzKGRhdGE9VFNMQV90cmltJEFtb3VudCwgc3RhcnQgPSBjKDIwMDkpLCBmcmVxdWVuY3kgPSAxKQphcmltYSA8LSBhdXRvLmFyaW1hKHRzKQpwcm9ub3N0aWNvIDwtIGZvcmVjYXN0KGFyaW1hLCBsZXZlbCA9IGMoOTUpLCBoID0gNSkKCnBsb3QocHJvbm9zdGljbywgbWFpbiA9ICJQcm9ub3N0aWNvIFZlbnRhcyBBbnVhbGVzIFRlc2xhIChlbiBiaWxsb25lcykiKQpgYGAKCiFbXShBbnVhbC5wbmcpCgojIyBBbmFsaXNpcyBUcnRpbWVzdHJhbApgYGB7ciwgZXZhbD1GQUxTRX0KdHMgPC0gdHMoZGF0YT1UU0xBX3llYXIkQW1vdW50LCBzdGFydCA9IGMoMjAxMSwxKSwgZnJlcXVlbmN5ID0gNCkKYXJpbWEgPC0gYXV0by5hcmltYSh0cykKcHJvbm9zdGljbyA8LSBmb3JlY2FzdChhcmltYSwgbGV2ZWwgPSBjKDk1KSwgaCA9IDgpCgpwbG90KHByb25vc3RpY28sIG1haW4gPSAiUHJvbm9zdGljbyBWZW50YXMgVHJpbWVzdHJhbGVzIFRlc2xhIChlbiBiaWxsb25lcykiKQpgYGAKCiFbXShUcmltLnBuZykKCgoKCgoKCgoKCgoKCg==