Cargar librerías

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

Obtener datos de American Express

options(HTTPUserAgent = "a a@gmail.com")
#CompanyInfo("AXP")
#AnnualReports("AXP", foreign = FALSE)
df_2016 <- GetIncome("AXP",2016) 
df_2012 <- GetIncome("AXP",2012) 
#Amex <- GetBalanceSheet("AXP",2015)
#AmazonBL <- GetBalanceSheet("AXP",2012)

Consolidar base de datos

CompanyInfo("AXP") #nombre de la banca
##               company        CIK  SIC state state.inc FY.end
## 1 AMERICAN EXPRESS CO 0000004962 6199    NY        NY   1231
##                street.address        city.state
## 1 200 VESEY STREET 50TH FLOOR NEW YORK NY 10285
amex_income1 <- GetIncome("AXP", 2016)

amex_income2 <- GetIncome("AXP", 2013)

amex_income <- rbind(amex_income1,amex_income2)

Seleccionar variables que analizaremos

selected_rows <- amex_income[grepl("^(noninterest income|interest expense)$", amex_income$Metric, ignore.case = TRUE), ]
print(selected_rows)
##                 Metric Units      Amount  startDate    endDate
## 19    Interest Expense   USD  1958000000 2013-01-01 2013-12-31
## 20    Interest Expense   USD  1707000000 2014-01-01 2014-12-31
## 21    Interest Expense   USD  1623000000 2015-01-01 2015-12-31
## 40  Noninterest Income   USD 27823000000 2013-01-01 2013-12-31
## 41  Noninterest Income   USD 28716000000 2014-01-01 2014-12-31
## 42  Noninterest Income   USD 26896000000 2015-01-01 2015-12-31
## 142   Interest Expense   USD  2423000000 2010-01-01 2010-12-31
## 143   Interest Expense   USD  2320000000 2011-01-01 2011-12-31
## 144   Interest Expense   USD  2226000000 2012-01-01 2012-12-31
## 163 Noninterest Income   USD 22932000000 2010-01-01 2010-12-31
## 164 Noninterest Income   USD 25586000000 2011-01-01 2011-12-31
## 165 Noninterest Income   USD 26954000000 2012-01-01 2012-12-31

Cambiar tipo de variables y acomodar por fecha

# Convertir 'startDate' a fecha
selected_rows$startDate <- as.Date(selected_rows$startDate)

# Convertir 'Amount' a numérico
selected_rows$Amount <- as.numeric(selected_rows$Amount)

# Ordenar base de datos por 'startDate' en orden ascendiente
selected_rows <- selected_rows[order(selected_rows$startDate), ]

Serie de tiempo de los gastos de intereses

# Filtrar filas que contienen "Interest Expense"
interest_expense_data <- selected_rows[selected_rows$Metric == "Interest Expense", ]

# Crear serie de tiempo
ts1 <- ts(interest_expense_data$Amount, start = c(2010, 1), frequency = 1)

# Graficar la serie de tiempo
plot(ts1, main = "Gastos por Intereses", xlab = "Año", ylab = "Cantidad")

Al visualizar la gráfica de serie de tiempo sobre los gastos por intereses, podemos notar que hay un decremento de dichos intereses con el tiempo, eso le permite a la empresa liquidar sus deudas más rápido.

Arima de los gastos de intereses

arima2<-auto.arima(ts1, D=1)
summary(arima2)
## Series: ts1 
## ARIMA(0,1,0) with drift 
## 
## Coefficients:
##            drift
##       -160000000
## s.e.    36237161
## 
## sigma^2 = 8.333e+15:  log likelihood = -98.18
## AIC=200.37   AICc=206.37   BIC=199.59
## 
## Training set error measures:
##                    ME     RMSE      MAE        MPE     MAPE     MASE
## Training set 430499.8 74534860 66763833 -0.1059461 3.509661 0.417274
##                     ACF1
## Training set -0.00822753

El mejor modelo de Arima fue el 0, 1, 0.

Generar el pronóstico

pronostico2 <- forecast(arima2,level=c(95), h=6)
pronostico2
##      Point Forecast      Lo 95      Hi 95
## 2016      1.463e+09 1284082361 1641917639
## 2017      1.303e+09 1049972248 1556027752
## 2018      1.143e+09  833105559 1452894441
## 2019      9.830e+08  625164722 1340835278
## 2020      8.230e+08  422927997 1223072004
## 2021      6.630e+08  224743078 1101256922
plot(pronostico2)

En el pronóstico podemos ver que el decremento va a continuar en los próximos cinco años, lo cual es algo positivo para la empresa.

Serie de tiempo de los ingresos sin intereses

# Filtrar filas que contienen "Noninterest Income"
NoninterestIncome_data <- selected_rows[selected_rows$Metric == "Noninterest Income", ]

# Crear serie de tiempo
ts2 <- ts(NoninterestIncome_data$Amount, start = c(2010, 1), frequency = 1)

# Graficar la serie de tiempo
plot(ts2, main = "Ingresos sin intereses", xlab = "Año", ylab = "Cantidad")

En esta serie de tiempo podemos ver que en los primeros cinco años los ingresos sin intereses estuvieron en constante crecimiento, sin embargo, no se cuenta con una tendencia ya que en el año 2015 decrementa.

Arima de tiempo de los ingresos sin intereses

arima3 <- auto.arima(ts2)
summary(arima3)
## Series: ts2 
## ARIMA(0,0,0) with non-zero mean 
## 
## Coefficients:
##              mean
##       26484500000
## s.e.    881627458
## 
## sigma^2 = 4.118e+18:  log likelihood = -136.55
## AIC=277.1   AICc=281.1   BIC=276.69
## 
## Training set error measures:
##                         ME       RMSE        MAE        MPE     MAPE     MASE
## Training set -7.629395e-06 1852408140 1483666667 -0.5249364 5.809443 0.975583
##                   ACF1
## Training set 0.3547431

El mejor modelo arima fue el 0, 0, 0.

# Ordenar las variables por importancia, cambiandolo de manera manual para que con el pronóstico se obtengan mejores resultados.
p <- 1
d <- 2  
q <- 2  

arima3 <- arima(ts2, order = c(p, d, q))
summary(arima3)
## 
## Call:
## arima(x = ts2, order = c(p, d, q))
## 
## Coefficients:
##          ar1      ma1     ma2
##       0.9242  -1.5753  0.9954
## s.e.  0.5270   1.9381  1.7025
## 
## sigma^2 estimated as 7.979e+17:  log likelihood = -89.62,  aic = 187.23
## 
## Training set error measures:
##                      ME      RMSE       MAE       MPE     MAPE      MASE
## Training set -370292525 729436755 509937740 -1.385376 1.874676 0.3353089
##                   ACF1
## Training set -0.372435

Generar el pronóstico

pronostico3 <- forecast(arima3,level=c(95), h=6)
pronostico3
##      Point Forecast        Lo 95       Hi 95
## 2016    25291280472  23240214707 27342346237
## 2017    22699173211  18927261804 26471084618
## 2018    19194535881  12981620194 25407451568
## 2019    14846550897   5231707461 24461394334
## 2020     9719155692  -4380418966 23818730350
## 2021     3871440352 -15864755711 23607636415
plot(pronostico3)

En este pronóstico se puede visualizar que en los próximos 5 años, la empresa tendrá una decadencia de ingresos sin intereses empresa.

LS0tDQp0aXRsZTogIlRhcmVhIDIiDQphdXRob3I6ICJHZXJhcmRvIEdhcnphIC0gQTAxMzgzMjg3LCBEYW5pZWxhIEdhcnphIC0gQTAxNzIxMDcxLCBSYXF1ZWwgR2FyemEgLSBBMDA4MzAyMDMiDQpkYXRlOiAiMjAyNC0wMi0xOSINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KLS0tDQoNCiFbXShjcmVkaXRfQ2FyZC5naWYpDQoNCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpDQpgYGANCg0KIyMgQ2FyZ2FyIGxpYnJlcsOtYXMNCmBgYHtyfQ0KbGlicmFyeShmaW5yZXBvcnRyKQ0KbGlicmFyeShmb3JlY2FzdCkNCmBgYA0KDQoNCiMjIE9idGVuZXIgZGF0b3MgZGUgQW1lcmljYW4gRXhwcmVzcw0KYGBge3J9DQpvcHRpb25zKEhUVFBVc2VyQWdlbnQgPSAiYSBhQGdtYWlsLmNvbSIpDQojQ29tcGFueUluZm8oIkFYUCIpDQojQW5udWFsUmVwb3J0cygiQVhQIiwgZm9yZWlnbiA9IEZBTFNFKQ0KZGZfMjAxNiA8LSBHZXRJbmNvbWUoIkFYUCIsMjAxNikgDQpkZl8yMDEyIDwtIEdldEluY29tZSgiQVhQIiwyMDEyKSANCiNBbWV4IDwtIEdldEJhbGFuY2VTaGVldCgiQVhQIiwyMDE1KQ0KI0FtYXpvbkJMIDwtIEdldEJhbGFuY2VTaGVldCgiQVhQIiwyMDEyKQ0KYGBgDQoNCiMjIENvbnNvbGlkYXIgYmFzZSBkZSBkYXRvcw0KYGBge3J9DQpDb21wYW55SW5mbygiQVhQIikgI25vbWJyZSBkZSBsYSBiYW5jYQ0KYW1leF9pbmNvbWUxIDwtIEdldEluY29tZSgiQVhQIiwgMjAxNikNCg0KYW1leF9pbmNvbWUyIDwtIEdldEluY29tZSgiQVhQIiwgMjAxMykNCg0KYW1leF9pbmNvbWUgPC0gcmJpbmQoYW1leF9pbmNvbWUxLGFtZXhfaW5jb21lMikNCg0KYGBgDQojIyBTZWxlY2Npb25hciB2YXJpYWJsZXMgcXVlIGFuYWxpemFyZW1vcw0KYGBge3J9DQpzZWxlY3RlZF9yb3dzIDwtIGFtZXhfaW5jb21lW2dyZXBsKCJeKG5vbmludGVyZXN0IGluY29tZXxpbnRlcmVzdCBleHBlbnNlKSQiLCBhbWV4X2luY29tZSRNZXRyaWMsIGlnbm9yZS5jYXNlID0gVFJVRSksIF0NCnByaW50KHNlbGVjdGVkX3Jvd3MpDQoNCmBgYA0KDQojIyBDYW1iaWFyIHRpcG8gZGUgdmFyaWFibGVzIHkgYWNvbW9kYXIgcG9yIGZlY2hhDQpgYGB7cn0NCiMgQ29udmVydGlyICdzdGFydERhdGUnIGEgZmVjaGENCnNlbGVjdGVkX3Jvd3Mkc3RhcnREYXRlIDwtIGFzLkRhdGUoc2VsZWN0ZWRfcm93cyRzdGFydERhdGUpDQoNCiMgQ29udmVydGlyICdBbW91bnQnIGEgbnVtw6lyaWNvDQpzZWxlY3RlZF9yb3dzJEFtb3VudCA8LSBhcy5udW1lcmljKHNlbGVjdGVkX3Jvd3MkQW1vdW50KQ0KDQojIE9yZGVuYXIgYmFzZSBkZSBkYXRvcyBwb3IgJ3N0YXJ0RGF0ZScgZW4gb3JkZW4gYXNjZW5kaWVudGUNCnNlbGVjdGVkX3Jvd3MgPC0gc2VsZWN0ZWRfcm93c1tvcmRlcihzZWxlY3RlZF9yb3dzJHN0YXJ0RGF0ZSksIF0NCg0KYGBgDQoNCiMjIFNlcmllIGRlIHRpZW1wbyBkZSBsb3MgZ2FzdG9zIGRlIGludGVyZXNlcw0KYGBge3J9DQoNCiMgRmlsdHJhciBmaWxhcyBxdWUgY29udGllbmVuICJJbnRlcmVzdCBFeHBlbnNlIg0KaW50ZXJlc3RfZXhwZW5zZV9kYXRhIDwtIHNlbGVjdGVkX3Jvd3Nbc2VsZWN0ZWRfcm93cyRNZXRyaWMgPT0gIkludGVyZXN0IEV4cGVuc2UiLCBdDQoNCiMgQ3JlYXIgc2VyaWUgZGUgdGllbXBvDQp0czEgPC0gdHMoaW50ZXJlc3RfZXhwZW5zZV9kYXRhJEFtb3VudCwgc3RhcnQgPSBjKDIwMTAsIDEpLCBmcmVxdWVuY3kgPSAxKQ0KDQojIEdyYWZpY2FyIGxhIHNlcmllIGRlIHRpZW1wbw0KcGxvdCh0czEsIG1haW4gPSAiR2FzdG9zIHBvciBJbnRlcmVzZXMiLCB4bGFiID0gIkHDsW8iLCB5bGFiID0gIkNhbnRpZGFkIikNCg0KYGBgDQoNCg0KQWwgdmlzdWFsaXphciBsYSBncsOhZmljYSBkZSBzZXJpZSBkZSB0aWVtcG8gc29icmUgbG9zIGdhc3RvcyBwb3IgaW50ZXJlc2VzLCBwb2RlbW9zIG5vdGFyIHF1ZSBoYXkgdW4gZGVjcmVtZW50byBkZSBkaWNob3MgaW50ZXJlc2VzIGNvbiBlbCB0aWVtcG8sIGVzbyBsZSBwZXJtaXRlIGEgbGEgZW1wcmVzYSBsaXF1aWRhciBzdXMgZGV1ZGFzIG3DoXMgcsOhcGlkby4NCg0KIyMgQXJpbWEgZGUgbG9zIGdhc3RvcyBkZSBpbnRlcmVzZXMNCmBgYHtyfQ0KYXJpbWEyPC1hdXRvLmFyaW1hKHRzMSwgRD0xKQ0Kc3VtbWFyeShhcmltYTIpDQpgYGANCkVsIG1lam9yIG1vZGVsbyBkZSBBcmltYSBmdWUgZWwgMCwgMSwgMC4NCg0KIyMgR2VuZXJhciBlbCBwcm9uw7NzdGljbw0KYGBge3J9DQpwcm9ub3N0aWNvMiA8LSBmb3JlY2FzdChhcmltYTIsbGV2ZWw9Yyg5NSksIGg9NikNCnByb25vc3RpY28yDQpwbG90KHByb25vc3RpY28yKQ0KYGBgDQoNCg0KRW4gZWwgcHJvbsOzc3RpY28gcG9kZW1vcyB2ZXIgcXVlIGVsIGRlY3JlbWVudG8gdmEgYSBjb250aW51YXIgZW4gbG9zIHByw7N4aW1vcyBjaW5jbyBhw7FvcywgbG8gY3VhbCBlcyBhbGdvIHBvc2l0aXZvIHBhcmEgbGEgZW1wcmVzYS4NCg0KIyMgU2VyaWUgZGUgdGllbXBvIGRlIGxvcyBpbmdyZXNvcyBzaW4gaW50ZXJlc2VzDQpgYGB7cn0NCiMgRmlsdHJhciBmaWxhcyBxdWUgY29udGllbmVuICJOb25pbnRlcmVzdCBJbmNvbWUiDQpOb25pbnRlcmVzdEluY29tZV9kYXRhIDwtIHNlbGVjdGVkX3Jvd3Nbc2VsZWN0ZWRfcm93cyRNZXRyaWMgPT0gIk5vbmludGVyZXN0IEluY29tZSIsIF0NCg0KIyBDcmVhciBzZXJpZSBkZSB0aWVtcG8NCnRzMiA8LSB0cyhOb25pbnRlcmVzdEluY29tZV9kYXRhJEFtb3VudCwgc3RhcnQgPSBjKDIwMTAsIDEpLCBmcmVxdWVuY3kgPSAxKQ0KDQojIEdyYWZpY2FyIGxhIHNlcmllIGRlIHRpZW1wbw0KcGxvdCh0czIsIG1haW4gPSAiSW5ncmVzb3Mgc2luIGludGVyZXNlcyIsIHhsYWIgPSAiQcOxbyIsIHlsYWIgPSAiQ2FudGlkYWQiKQ0KDQpgYGANCg0KDQpFbiBlc3RhIHNlcmllIGRlIHRpZW1wbyBwb2RlbW9zIHZlciBxdWUgZW4gbG9zIHByaW1lcm9zIGNpbmNvIGHDsW9zIGxvcyBpbmdyZXNvcyBzaW4gaW50ZXJlc2VzIGVzdHV2aWVyb24gZW4gY29uc3RhbnRlIGNyZWNpbWllbnRvLCBzaW4gZW1iYXJnbywgbm8gc2UgY3VlbnRhIGNvbiB1bmEgdGVuZGVuY2lhIHlhIHF1ZSBlbiBlbCBhw7FvIDIwMTUgZGVjcmVtZW50YS4gDQoNCiMjIEFyaW1hIGRlIHRpZW1wbyBkZSBsb3MgaW5ncmVzb3Mgc2luIGludGVyZXNlcw0KYGBge3J9DQphcmltYTMgPC0gYXV0by5hcmltYSh0czIpDQpzdW1tYXJ5KGFyaW1hMykNCmBgYA0KRWwgbWVqb3IgbW9kZWxvIGFyaW1hIGZ1ZSBlbCAwLCAwLCAwLg0KDQpgYGB7cn0NCiMgT3JkZW5hciBsYXMgdmFyaWFibGVzIHBvciBpbXBvcnRhbmNpYSwgY2FtYmlhbmRvbG8gZGUgbWFuZXJhIG1hbnVhbCBwYXJhIHF1ZSBjb24gZWwgcHJvbsOzc3RpY28gc2Ugb2J0ZW5nYW4gbWVqb3JlcyByZXN1bHRhZG9zLg0KcCA8LSAxDQpkIDwtIDIgIA0KcSA8LSAyICANCg0KYXJpbWEzIDwtIGFyaW1hKHRzMiwgb3JkZXIgPSBjKHAsIGQsIHEpKQ0Kc3VtbWFyeShhcmltYTMpDQoNCmBgYA0KDQojIyBHZW5lcmFyIGVsIHByb27Ds3N0aWNvDQoNCmBgYHtyfQ0KcHJvbm9zdGljbzMgPC0gZm9yZWNhc3QoYXJpbWEzLGxldmVsPWMoOTUpLCBoPTYpDQpwcm9ub3N0aWNvMw0KcGxvdChwcm9ub3N0aWNvMykNCmBgYA0KDQoNCkVuIGVzdGUgcHJvbsOzc3RpY28gc2UgcHVlZGUgdmlzdWFsaXphciBxdWUgZW4gbG9zIHByw7N4aW1vcyA1IGHDsW9zLCBsYSBlbXByZXNhIHRlbmRyw6EgdW5hIGRlY2FkZW5jaWEgZGUgaW5ncmVzb3Mgc2luIGludGVyZXNlcyAgZW1wcmVzYS4g