
Importamos las
librerías
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(plm)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:plm':
##
## between, lag, lead
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
Cargar datos
datos<-read.csv("historical_state_population_by_year.csv")
colnames(datos)<-c("Estado","Año","Poblacion")
Serie de Tiempo
Exportación de datos
predichos
Generamos una data frame distinto para poder graficar los mapas.
Tambien se exportara un csv para realizar una app shiny.
# Crear un dataframe vacío para almacenar los pronósticos en forma de panel
forecast_panel <- data.frame(state = character(), year = numeric(), prediction = numeric())
# Iterar sobre los nombres en panel_list
for (state in names(panel_list)) {
# Acceder al pronóstico correspondiente en arima_models
forecast <- arima_models[[state]]$forecast
# Crear un dataframe temporal para el estado actual
state_forecast <- data.frame(state = rep(state, length(forecast)), year = seq(2020, 2079), prediction = forecast)
# Agregar el dataframe temporal al dataframe forecast_panel
forecast_panel <- rbind(forecast_panel, state_forecast)
}
# Seleccionar y renombrar columnas pertinentes
forecast_panel <- forecast_panel %>% select(1:3)
colnames(forecast_panel) <- c("Estado", "Año", "Poblacion")
Construcción de
Mapas
Nuevamente crearemos un loop para la creación de los mapas
# Definir años específicos para el análisis
anios <- c(2030, 2040, 2050, 2060, 2070)
# Iterar sobre los años para generar mapas
for (i in anios) {
# Filtrar el dataframe de pronósticos para el año actual
df2 <- forecast_panel %>% filter(Año == i)
# Calcular los cuartiles y asignar colores correspondientes
df2 <- within(df2, quartile <- as.integer(cut(Poblacion, quantile(Poblacion, probs = 0:4/4), include.lowest = TRUE)))
df2$col[df2$quartile == 1] <- 'cadetblue2'
df2$col[df2$quartile == 2] <- 'cadetblue3'
df2$col[df2$quartile == 3] <- 'cadetblue'
df2$col[df2$quartile == 4] <- 'cadetblue4'
# Renombrar los estados con códigos a nombres completos
df2$Estado[df2$Estado == 'TX'] <- 'Texas'
df2$Estado[df2$Estado == 'ND'] <- 'North Dakota'
df2$Estado[df2$Estado == 'SD'] <- 'South Dakota'
df2$Estado[df2$Estado == 'KS'] <- 'Kansas'
df2$Estado[df2$Estado == 'IA'] <- 'Iowa'
df2$Estado[df2$Estado == 'VT'] <- 'Vermont'
df2$Estado[df2$Estado == 'PA'] <- 'Pennsylvania'
df2$Estado[df2$Estado == 'KY'] <- 'Kentucky'
df2$Estado[df2$Estado == 'WV'] <- 'West Virginia'
df2$Estado[df2$Estado == 'VA'] <- 'Virginia'
df2$Estado[df2$Estado == 'TN'] <- 'Tennessee'
df2$Estado[df2$Estado == 'NC'] <- 'North Carolina'
df2$Estado[df2$Estado == 'SC'] <- 'South Carolina'
df2$Estado[df2$Estado == 'GA'] <- 'Georgia'
df2$Estado[df2$Estado == 'LA'] <- 'Louisiana'
# Generar mapa con los colores asignados
map(database = 'state')
map(database = 'state', regions = df2$state, col = df2$col, fill = TRUE, add = TRUE)
title(paste("Mapa del año", i))
}





LS0tDQp0aXRsZTogIkFjdGl2aWRhZCBJbnRlZ3JhZG9yYSINCmF1dGhvcjogSm9zw6kgR2FicmllbCBVc2nDsWEgTW9ncm8gQTAwODMxNDM1ICBMb3JlbmEgVmlsbGFycmVhbCBWZWdhIEEwMTcyMDgwMiBYaW1lbmENCiAgU29sw61zIElzbGFzIEEwMDgzMTM3MQ0KZGF0ZTogIjIwMjQtMDItMjEiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdGhlbWU6IHVuaXRlZA0KICAgIGhpZ2hsaWdodDogdGFuZ28NCiAgICB0b2M6IHRydWUNCiAgICB0b2NfZGVwdGg6IDMNCiAgICBudW1iZXJfc2VjdGlvbnM6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IHRydWUNCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlDQotLS0NCiFbXShodHRwczovL21lZGlhLmdpcGh5LmNvbS9tZWRpYS9YcDJhTWl6bU1ZYU1vL2dpcGh5LmdpZikNCg0KIyBJbXBvcnRhbW9zIGxhcyBsaWJyZXLDrWFzDQpgYGB7ciB3YXJuaW5nPUZBTFNFfQ0KbGlicmFyeShmb3JlY2FzdCkNCmxpYnJhcnkocGxtKQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkobWFwcykNCmBgYA0KDQojIENhcmdhciBkYXRvcw0KYGBge3J9DQpkYXRvczwtcmVhZC5jc3YoImhpc3RvcmljYWxfc3RhdGVfcG9wdWxhdGlvbl9ieV95ZWFyLmNzdiIpDQpjb2xuYW1lcyhkYXRvcyk8LWMoIkVzdGFkbyIsIkHDsW8iLCJQb2JsYWNpb24iKQ0KYGBgDQoNCg0KIyBTZXJpZSBkZSBUaWVtcG8NCiMjIENvbnN0cnVjY2nDs24gZGVsIE1vZGVsbyANClJlYWxpemFyZW1vcyB1biBsb29wIHBhcmEgcG9kZXIgaGFjZXIgbGEgcHJlZGljY2nDs24gZGUgdG9kb3MgbG9zIGVzdGFkb3MNCmBgYHtyfQ0KIyBPcmRlbmFyIGxvcyBkYXRvcyBwb3IgYcOxbw0KZGF0b3MgPC0gZGF0b3Nbb3JkZXIoZGF0b3MkQcOxbyksIF0NCiMgRGl2aWRpciBsb3MgZGF0b3MgZW4gdW5hIGxpc3RhIHBvciBlc3RhZG8NCnBhbmVsX2xpc3QgPC0gc3BsaXQoZGF0b3MsIGRhdG9zJEVzdGFkbykNCiMgSW5pY2lhbGl6YXIgdW5hIGxpc3RhIHBhcmEgYWxtYWNlbmFyIGxvcyBtb2RlbG9zIEFSSU1BDQphcmltYV9tb2RlbHMgPC0gbGlzdCgpDQoNCiMgSXRlcmFyIHNvYnJlIGNhZGEgZXN0YWRvIHBhcmEgYWp1c3RhciB1biBtb2RlbG8gQVJJTUEgeSBoYWNlciBwcm9uw7NzdGljb3MNCmZvciAoc3RhdGUgaW4gbmFtZXMocGFuZWxfbGlzdCkpIHsNCiAgc3RhdGVfZGF0YSA8LSBwYW5lbF9saXN0W1tzdGF0ZV1dDQogIHRzX3N0YXRlIDwtIHRzKGRhdGEgPSBzdGF0ZV9kYXRhJFBvYmxhY2lvbiwgc3RhcnQgPSBtaW4oc3RhdGVfZGF0YSRBw7FvKSwgZnJlcXVlbmN5ID0gMSkNCiAgYXJpbWFfbW9kZWwgPC0gYXV0by5hcmltYSh0c19zdGF0ZSkNCiAgZm9yZWNhc3RfdmFsdWVzIDwtIGZvcmVjYXN0KGFyaW1hX21vZGVsLCBoID0gNjApICAjIEhhY2Vtb3MgcHJvbsOzc3RpY29zIGhhc3RhIGVsIGHDsW8gMjA3MA0KICBjbGVhbl9zdGF0ZV9uYW1lIDwtIHN0YXRlDQogIGFyaW1hX21vZGVsc1tbY2xlYW5fc3RhdGVfbmFtZV1dIDwtIGxpc3QobW9kZWwgPSBhcmltYV9tb2RlbCwgZm9yZWNhc3QgPSBmb3JlY2FzdF92YWx1ZXMpDQogIA0KICBwbG90KGZvcmVjYXN0X3ZhbHVlcywgbWFpbiA9IHBhc3RlKCJQcm9uw7NzdGljbyBkZSBwb2JsYWNpw7NuIGVuIiwgc3RhdGUpKQ0KfQ0KDQpgYGANCg0KIyMgRXhwb3J0YWNpw7NuIGRlIGRhdG9zIHByZWRpY2hvcw0KDQpHZW5lcmFtb3MgdW5hIGRhdGEgZnJhbWUgZGlzdGludG8gcGFyYSBwb2RlciBncmFmaWNhciBsb3MgbWFwYXMuIFRhbWJpZW4gc2UgZXhwb3J0YXJhIHVuIGNzdiBwYXJhIHJlYWxpemFyIHVuYSBhcHAgc2hpbnkuIA0KYGBge3J9DQojIENyZWFyIHVuIGRhdGFmcmFtZSB2YWPDrW8gcGFyYSBhbG1hY2VuYXIgbG9zIHByb27Ds3N0aWNvcyBlbiBmb3JtYSBkZSBwYW5lbA0KZm9yZWNhc3RfcGFuZWwgPC0gZGF0YS5mcmFtZShzdGF0ZSA9IGNoYXJhY3RlcigpLCB5ZWFyID0gbnVtZXJpYygpLCBwcmVkaWN0aW9uID0gbnVtZXJpYygpKQ0KDQojIEl0ZXJhciBzb2JyZSBsb3Mgbm9tYnJlcyBlbiBwYW5lbF9saXN0DQpmb3IgKHN0YXRlIGluIG5hbWVzKHBhbmVsX2xpc3QpKSB7DQogICMgQWNjZWRlciBhbCBwcm9uw7NzdGljbyBjb3JyZXNwb25kaWVudGUgZW4gYXJpbWFfbW9kZWxzDQogIGZvcmVjYXN0IDwtIGFyaW1hX21vZGVsc1tbc3RhdGVdXSRmb3JlY2FzdA0KICAjIENyZWFyIHVuIGRhdGFmcmFtZSB0ZW1wb3JhbCBwYXJhIGVsIGVzdGFkbyBhY3R1YWwNCiAgc3RhdGVfZm9yZWNhc3QgPC0gZGF0YS5mcmFtZShzdGF0ZSA9IHJlcChzdGF0ZSwgbGVuZ3RoKGZvcmVjYXN0KSksIHllYXIgPSBzZXEoMjAyMCwgMjA3OSksIHByZWRpY3Rpb24gPSBmb3JlY2FzdCkNCiAgIyBBZ3JlZ2FyIGVsIGRhdGFmcmFtZSB0ZW1wb3JhbCBhbCBkYXRhZnJhbWUgZm9yZWNhc3RfcGFuZWwNCiAgZm9yZWNhc3RfcGFuZWwgPC0gcmJpbmQoZm9yZWNhc3RfcGFuZWwsIHN0YXRlX2ZvcmVjYXN0KQ0KfQ0KDQojIFNlbGVjY2lvbmFyIHkgcmVub21icmFyIGNvbHVtbmFzIHBlcnRpbmVudGVzDQpmb3JlY2FzdF9wYW5lbCA8LSBmb3JlY2FzdF9wYW5lbCAlPiUgc2VsZWN0KDE6MykNCmNvbG5hbWVzKGZvcmVjYXN0X3BhbmVsKSA8LSBjKCJFc3RhZG8iLCAiQcOxbyIsICJQb2JsYWNpb24iKQ0KDQpgYGANCg0KIyMgQ29uc3RydWNjacOzbiBkZSBNYXBhcw0KTnVldmFtZW50ZSBjcmVhcmVtb3MgdW4gbG9vcCBwYXJhIGxhIGNyZWFjacOzbiBkZSBsb3MgbWFwYXMgDQpgYGB7cn0NCiMgRGVmaW5pciBhw7FvcyBlc3BlY8OtZmljb3MgcGFyYSBlbCBhbsOhbGlzaXMNCmFuaW9zIDwtIGMoMjAzMCwgMjA0MCwgMjA1MCwgMjA2MCwgMjA3MCkNCg0KIyBJdGVyYXIgc29icmUgbG9zIGHDsW9zIHBhcmEgZ2VuZXJhciBtYXBhcw0KZm9yIChpIGluIGFuaW9zKSB7DQogICMgRmlsdHJhciBlbCBkYXRhZnJhbWUgZGUgcHJvbsOzc3RpY29zIHBhcmEgZWwgYcOxbyBhY3R1YWwNCiAgZGYyIDwtIGZvcmVjYXN0X3BhbmVsICU+JSBmaWx0ZXIoQcOxbyA9PSBpKQ0KICANCiAgIyBDYWxjdWxhciBsb3MgY3VhcnRpbGVzIHkgYXNpZ25hciBjb2xvcmVzIGNvcnJlc3BvbmRpZW50ZXMNCiAgZGYyIDwtIHdpdGhpbihkZjIsIHF1YXJ0aWxlIDwtIGFzLmludGVnZXIoY3V0KFBvYmxhY2lvbiwgcXVhbnRpbGUoUG9ibGFjaW9uLCBwcm9icyA9IDA6NC80KSwgaW5jbHVkZS5sb3dlc3QgPSBUUlVFKSkpDQogIGRmMiRjb2xbZGYyJHF1YXJ0aWxlID09IDFdIDwtICdjYWRldGJsdWUyJw0KICBkZjIkY29sW2RmMiRxdWFydGlsZSA9PSAyXSA8LSAnY2FkZXRibHVlMycNCiAgZGYyJGNvbFtkZjIkcXVhcnRpbGUgPT0gM10gPC0gJ2NhZGV0Ymx1ZScNCiAgZGYyJGNvbFtkZjIkcXVhcnRpbGUgPT0gNF0gPC0gJ2NhZGV0Ymx1ZTQnDQogIA0KICAjIFJlbm9tYnJhciBsb3MgZXN0YWRvcyBjb24gY8OzZGlnb3MgYSBub21icmVzIGNvbXBsZXRvcw0KICBkZjIkRXN0YWRvW2RmMiRFc3RhZG8gPT0gJ1RYJ10gPC0gJ1RleGFzJw0KICBkZjIkRXN0YWRvW2RmMiRFc3RhZG8gPT0gJ05EJ10gPC0gJ05vcnRoIERha290YScNCiAgZGYyJEVzdGFkb1tkZjIkRXN0YWRvID09ICdTRCddIDwtICdTb3V0aCBEYWtvdGEnDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnS1MnXSA8LSAnS2Fuc2FzJw0KICBkZjIkRXN0YWRvW2RmMiRFc3RhZG8gPT0gJ0lBJ10gPC0gJ0lvd2EnDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnVlQnXSA8LSAnVmVybW9udCcNCiAgZGYyJEVzdGFkb1tkZjIkRXN0YWRvID09ICdQQSddIDwtICdQZW5uc3lsdmFuaWEnDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnS1knXSA8LSAnS2VudHVja3knDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnV1YnXSA8LSAnV2VzdCBWaXJnaW5pYScNCiAgZGYyJEVzdGFkb1tkZjIkRXN0YWRvID09ICdWQSddIDwtICdWaXJnaW5pYScNCiAgZGYyJEVzdGFkb1tkZjIkRXN0YWRvID09ICdUTiddIDwtICdUZW5uZXNzZWUnDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnTkMnXSA8LSAnTm9ydGggQ2Fyb2xpbmEnDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnU0MnXSA8LSAnU291dGggQ2Fyb2xpbmEnDQogIGRmMiRFc3RhZG9bZGYyJEVzdGFkbyA9PSAnR0EnXSA8LSAnR2VvcmdpYScNCiAgZGYyJEVzdGFkb1tkZjIkRXN0YWRvID09ICdMQSddIDwtICdMb3Vpc2lhbmEnDQogIA0KICAjIEdlbmVyYXIgbWFwYSBjb24gbG9zIGNvbG9yZXMgYXNpZ25hZG9zDQogIG1hcChkYXRhYmFzZSA9ICdzdGF0ZScpDQogIG1hcChkYXRhYmFzZSA9ICdzdGF0ZScsIHJlZ2lvbnMgPSBkZjIkc3RhdGUsIGNvbCA9IGRmMiRjb2wsIGZpbGwgPSBUUlVFLCBhZGQgPSBUUlVFKQ0KICB0aXRsZShwYXN0ZSgiTWFwYSBkZWwgYcOxbyIsIGkpKQ0KfQ0KDQpgYGANCg0K