Tareas en equipo realizadas por:
Ana López
Astrid González
Santiago González
| Generación de Pronósticos
Población de Texas y Mapeo
Carga de datos
poblacion<- read.csv("historical_state_population_by_year.csv", header = 0) %>% rename("State"="V1","Year"="V2","Population"="V3")
head(poblacion)
## State Year Population
## 1 AK 1950 135000
## 2 AK 1951 158000
## 3 AK 1952 189000
## 4 AK 1953 205000
## 5 AK 1954 215000
## 6 AK 1955 222000
Generación de Index por estado
# Asegúrate de que la variable AK esté en formato de texto (character)
poblacion$State <- as.character(poblacion$State)
# Crea un vector con los nombres de los estados únicos, ordenados alfabéticamente
un_estados <- sort(unique(poblacion$State))
# Crea un nuevo vector numérico que asigne un número a cada estado en función de su orden alfabético
codigo_numerico <- seq_along(un_estados)
# Asigna el código numérico correspondiente a cada estado en una nueva columna
poblacion$codigo_estado <- codigo_numerico[match(poblacion$State, un_estados)]
# Ahora 'poblacion' contendrá una nueva columna llamada 'codigo_estado' con el código numérico para cada estado.
head(poblacion)
## State Year Population codigo_estado
## 1 AK 1950 135000 1
## 2 AK 1951 158000 1
## 3 AK 1952 189000 1
## 4 AK 1953 205000 1
## 5 AK 1954 215000 1
## 6 AK 1955 222000 1
Seleccuón de datos
Se seleccionaron solo los años en década para asegurarnos que todos los estados tuvieran la misma cantidad de datos y no contar con faltantes.
poblacion<-subset(poblacion, Year==1950| Year==1960 | Year==1970| Year==1980 | Year==1990 | Year==2000 | Year==2010)
head(poblacion)
## State Year Population codigo_estado
## 1 AK 1950 135000 1
## 11 AK 1960 229000 1
## 21 AK 1970 302583 1
## 31 AK 1980 405315 1
## 41 AK 1990 553120 1
## 51 AK 2000 627963 1
vis_miss(poblacion)
No es necesario hacer una transformación/imputación de datos
Generación de pronosticos
Se realizó un modelo que permite iterar a lo largo de cada índice creado por estado para generar un pronóstico individual, de esta manera se genera un pronóstico especifico para cada estado que después será unido para generar los mapas.
codigo_numerico<- unlist(codigo_numerico) %>% list(codigo_numerico)
pob_ts_state<- list()
resultados_pronosticos<- list()
resultados_plot<- list()
for (i in 1:51){
pob<-subset(poblacion, codigo_estado==i)
pob<-select(pob, c(Year,Population, State))
pob2<- pob
minYear<- min(pob$Year)
state<-pob$State
pob<-pob %>% select(Population)
pob_ts<- ts(data=pob, start = c(minYear,1), frequency = 1)
pob_ts_state[[i]]<- pob_ts
## Modelado
model<- auto.arima(pob_ts, D=1)
sum_model<-summary(model)
## Pronostico
pronostico<- forecast(model, level = c(95), h=51)
pronostico<- pronostico %>% as.data.frame()
# Agregar la columna 'state' con el valor 'soloMN' en cada fila
pronostico <- pronostico %>% mutate(State = rep(unique(state), nrow(pronostico)))
# Crear la lista de años del 2020 al 2070 y agregarla como la columna 'year'
pronostico$Year <- seq(2020, 2070)
# Seleccionar solo columnas
pronostico<- pronostico[, c("State", "Year", "Point Forecast")]
names(pronostico)[names(pronostico) == "Point Forecast"] <- "Population"
pronostico <- rbind(pob2, pronostico)
resultados_pronosticos[[i]]<-pronostico
}
Consolidación de los modelos
state_forecast<- do.call(rbind, resultados_pronosticos)
head(state_forecast)
## Year Population State
## 1 1950 135000 AK
## 11 1960 229000 AK
## 21 1970 302583 AK
## 31 1980 405315 AK
## 41 1990 553120 AK
## 51 2000 627963 AK
Selección de fechas a mostrar (Décadas)
state_forecast<-subset(state_forecast, Year==1950| Year==1960 | Year==1970| Year==1980 | Year==1990 | Year==2000 | Year==2010 | Year==2020 | Year==2030 | Year==2040 | Year==2050 | Year==2060)
head(state_forecast)
## Year Population State
## 1 1950 135000 AK
## 11 1960 229000 AK
## 21 1970 302583 AK
## 31 1980 405315 AK
## 41 1990 553120 AK
## 51 2000 627963 AK
#write.csv(state_forecast, file= "PopulationForecasted_State.csv")
Creación de Mapas
Para la creación de los mapas se desarrolló una aplicación de Shiny que permite visualizar año con año los valores reales (de 1950 hasta 2010) y la predicción a partir de 2020.
Se anexa un vídeo de su utilización así como el enlace para acceder a la app:
Acceso a la aplicación | Vídeo explicativo