Actividad Integradora: Demografía USA

Integrantes del equipo:

• Regina Enríquez Chapa A01721435

• Maximiliano Carvajal A01552179

• Guillermo Cazares Cruz A01283709

Instalar paquetes y llamar librerías

#install.packages("maps")
#install.packages("readr")
#install.packages("forecast")
#install.packages("ggplot2")
#install.packages("dplyr")

library(maps)
library(readr)
library(forecast)
library(ggplot2)
library(dplyr)

Base de datos del censo de población de USA por estado

#Importación de base de datos
green_go <- read_csv("historical_state_population_by_year.csv")
#green_go <- read_csv("D:/8vo semestre/historical_state_population_by_year.csv")
colnames(green_go) <- c("State","Year","Population")
head(green_go)

## # A tibble: 6 × 3
##   State  Year Population
##   <chr> <dbl>      <dbl>
## 1 AK     1951     158000
## 2 AK     1952     189000
## 3 AK     1953     205000
## 4 AK     1954     215000
## 5 AK     1955     222000
## 6 AK     1956     224000

Pronóstico de los estados (Series de tiempo, Modelos Arima, y Pronósticos)

Estados Seleccionados:

Abreviación	Estado
PA	Pensylvannia
IL	Illinois
OH	Ohio
NC	North Carolina
GA	Georgia

Pronóstico Pennsylvania

#Guardar solo los datos de Pennsylvania
PA <- subset(green_go, State == "PA")

Serie de tiempo

#Crear la serie de tiempo, empezando desde 1900 hasta 2019, por año
ts_PA <- ts(data=PA$Population, start = c(1900,1), frequency = 1)
head(ts_PA)

## Time Series:
## Start = 1900 
## End = 1905 
## Frequency = 1 
## [1] 6313000 6439000 6567000 6699000 6833000 6970000

Modelo ARIMA

#Crear el modelo ARIMA para Pennsylvania
arima_PA <- auto.arima(ts_PA)
summary(arima_PA)

## Series: ts_PA 
## ARIMA(0,2,2) 
## 
## Coefficients:
##           ma1      ma2
##       -0.5098  -0.4160
## s.e.   0.0797   0.0787
## 
## sigma^2 = 8.94e+09:  log likelihood = -1519.25
## AIC=3044.49   AICc=3044.7   BIC=3052.81
## 
## Training set error measures:
##                     ME     RMSE      MAE        MPE      MAPE      MASE
## Training set -11297.47 92964.68 48959.44 -0.1096944 0.4757895 0.6274881
##                     ACF1
## Training set 0.007469667

Pronósticos

#Pronosticar la población durante las siguientes décadas, hasta 2070
pronostico_PA <- forecast(arima_PA, level=c(95), h=51)
plot(pronostico_PA)

Se pronostica que la población incrementará conforme pasan los años y décadas, también se puede apreciar que el pronóstico se vuelve más impreciso conforme se estiman más años.

#Guardar la población de 2030, 2040, 2050, 2060, 2070
PopPA <- pronostico_PA$mean[c(11,21,31,41,51)]

Pronóstico Illinois

#Guardar solo los datos de Illinois
IL <- subset(green_go, State == "IL")

Serie de tiempo

#Crear la serie de tiempo, empezando desde 1900 hasta 2019, por año
ts_IL <- ts(data=IL$Population, start = c(1900,1), frequency = 1)
head(ts_IL)

## Time Series:
## Start = 1900 
## End = 1905 
## Frequency = 1 
## [1] 4828000 4914000 4992000 5071000 5161000 5241000

Modelo Arima

#Crear el modelo ARIMA para Illinois
arima_IL <- auto.arima(ts_IL)
summary(arima_IL)

## Series: ts_IL 
## ARIMA(3,2,1) 
## 
## Coefficients:
##          ar1     ar2      ar3      ma1
##       0.0790  0.0424  -0.3400  -0.7050
## s.e.  0.1186  0.1000   0.0925   0.1044
## 
## sigma^2 = 6.155e+09:  log likelihood = -1495.86
## AIC=3001.72   AICc=3002.26   BIC=3015.58
## 
## Training set error measures:
##                     ME     RMSE      MAE         MPE      MAPE      MASE
## Training set -3927.761 76468.62 43652.01 -0.02872944 0.4920267 0.5507371
##                    ACF1
## Training set -0.0177474

Pronósticos

#Pronosticar la población durante las siguientes décadas, hasta 2070
pronostico_IL <- forecast(arima_IL, level=c(95), h=51)
plot(pronostico_IL)

Se pronostica que la población disminuirá conforme pasan los años y décadas, y nuevamente se aprecia que el pronóstico se vuelve más impreciso conforme se estiman más años.

#Guardar la población de 2030, 2040, 2050, 2060, 2070
PopIL <- pronostico_IL$mean[c(11,21,31,41,51)]

Pronóstico Ohio

#Guardar solo los datos de Ohio
OH <- subset(green_go, State == "OH")

Serie de tiempo

#Crear la serie de tiempo, empezando desde 1900 hasta 2019, por año
ts_OH <- ts(data=OH$Population, start = c(1900,1), frequency = 1)
head(ts_OH)

## Time Series:
## Start = 1900 
## End = 1905 
## Frequency = 1 
## [1] 4161000 4216000 4322000 4386000 4458000 4530000

Modelo Arima

#Crear el modelo ARIMA para Ohio
arima_OH <- auto.arima(ts_OH)
summary(arima_OH)

## Series: ts_OH 
## ARIMA(3,2,2) 
## 
## Coefficients:
##          ar1      ar2      ar3      ma1     ma2
##       0.6508  -0.0937  -0.3696  -1.2446  0.5125
## s.e.  0.3045   0.1325   0.0988   0.3349  0.2599
## 
## sigma^2 = 4.363e+09:  log likelihood = -1474.97
## AIC=2961.94   AICc=2962.7   BIC=2978.56
## 
## Training set error measures:
##                     ME     RMSE      MAE          MPE      MAPE      MASE
## Training set -1236.664 64095.18 33364.11 0.0004268429 0.4295383 0.5017015
##                      ACF1
## Training set -0.002722796

Pronósticos

#Pronosticar la población durante las siguientes décadas, hasta 2070
pronostico_OH <- forecast(arima_OH, level=c(95), h=51)
plot(pronostico_OH)

Se pronostica que la población incrementará poco conforme pasan los años y décadas, también se puede apreciar que el pronóstico se vuelve más impreciso conforme se estiman más años.

#Guardar la población de 2030, 2040, 2050, 2060, 2070
PopOH <- pronostico_OH$mean[c(11,21,31,41,51)]

Pronóstico North Carolina

#Guardar solo los datos de North Carolina
NC <- subset(green_go, State == "NC")

Serie de tiempo

#Crear la serie de tiempo, empezando desde 1900 hasta 2019, por año
ts_NC <- ts(data=NC$Population, start = c(1900,1), frequency = 1)
head(ts_NC)

## Time Series:
## Start = 1900 
## End = 1905 
## Frequency = 1 
## [1] 1897000 1926000 1956000 1986000 2017000 2051000

Modelo Arima

#Crear el modelo ARIMA para North Carolina
arima_NC <- auto.arima(ts_NC)
summary(arima_NC)

## Series: ts_NC 
## ARIMA(0,2,2) 
## 
## Coefficients:
##           ma1      ma2
##       -0.7066  -0.1454
## s.e.   0.0928   0.0920
## 
## sigma^2 = 2.134e+09:  log likelihood = -1434.41
## AIC=2874.83   AICc=2875.04   BIC=2883.14
## 
## Training set error measures:
##                    ME     RMSE      MAE        MPE      MAPE      MASE
## Training set 4905.901 45417.83 25061.71 0.09923176 0.5388346 0.3334805
##                    ACF1
## Training set -0.0222108

Pronósticos

#Pronosticar la población durante las siguientes décadas, hasta 2070
pronostico_NC <- forecast(arima_NC, level=c(95), h=51)
plot(pronostico_NC)

Se pronostica que la población incrementará de gran manera conforme pasan los años y décadas, también se puede apreciar que el pronóstico se vuelve más impreciso conforme se estiman más años.

#Guardar la población de 2030, 2040, 2050, 2060, 2070
PopNC <- pronostico_NC$mean[c(11,21,31,41,51)]

Pronóstico Georgia

#Guardar solo los datos de Georgia
GA <- subset(green_go, State == "GA")

Serie de tiempo

#Crear la serie de tiempo, empezando desde 1900 hasta 2019, por año
ts_GA <- ts(data=GA$Population, start = c(1900,1), frequency = 1)
head(ts_GA)

## Time Series:
## Start = 1900 
## End = 1905 
## Frequency = 1 
## [1] 2220000 2263000 2305000 2346000 2387000 2427000

Modelo Arima

#Crear el modelo ARIMA para Georgia
arima_GA <- auto.arima(ts_GA)
summary(arima_GA)

## Series: ts_GA 
## ARIMA(0,2,1) 
## 
## Coefficients:
##           ma1
##       -0.7683
## s.e.   0.0599
## 
## sigma^2 = 1.943e+09:  log likelihood = -1429.24
## AIC=2862.48   AICc=2862.58   BIC=2868.02
## 
## Training set error measures:
##                    ME     RMSE      MAE       MPE      MAPE      MASE
## Training set 2364.619 43524.82 25511.15 0.0491154 0.5731293 0.3342898
##                    ACF1
## Training set 0.08456536

Pronósticos

#Pronosticar la población durante las siguientes décadas, hasta 2070
pronostico_GA <- forecast(arima_GA, level=c(95), h=51)
plot(pronostico_GA)

Se pronostica que la población incrementará conforme pasan los años y décadas, también se puede apreciar que el pronóstico se vuelve más impreciso conforme se estiman más años.

#Guardar la población de 2030, 2040, 2050, 2060, 2070
PopGA <- pronostico_GA$mean[c(11,21,31,41,51)]

Mapeo de poblaciones por décadas (2030, 2040, 2050, 2060, 2070)

#Pronóstico de población para las siguientes 5 décadas en una base datos
Population_forecast <- data.frame(region = c("pennsylvania","illinois","ohio","north carolina","georgia"),
D2030 = c(PopPA[1], PopIL[1], PopOH[1], PopNC[1], PopGA[1]),
D2040 = c(PopPA[2], PopIL[2], PopOH[2], PopNC[2], PopGA[2]),
D2050 = c(PopPA[3], PopIL[3], PopOH[3], PopNC[3], PopGA[3]),
D2060 = c(PopPA[4], PopIL[4], PopOH[4], PopNC[4], PopGA[4]),
D2070 = c(PopPA[5], PopIL[5], PopOH[5], PopNC[5], PopGA[5]))
Population_forecast

##           region    D2030    D2040    D2050    D2060    D2070
## 1   pennsylvania 13080754 13342960 13605167 13867373 14129580
## 2       illinois 12363832 12070605 11777717 11484824 11191931
## 3           ohio 11883678 12061059 12237827 12414684 12591557
## 4 north carolina 11785748 12967114 14148480 15329845 16511211
## 5        georgia 11808766 12891805 13974843 15057882 16140921

#Juntar la base del mapa con la de los pronósticos de la población
usa <- map_data("state")
mapas <- left_join(usa, Population_forecast, by = "region")

#Décadas 2030, 2040, 2050, 2060, 2070
ggplot(data = mapas) + 
  geom_polygon(aes(x = long, y = lat, fill = D2030, group = group), color = "white") + 
  coord_fixed(1.3) +
  scale_fill_gradient(low = "red", high = "green") +
  ggtitle("Población 2030")

ggplot(data = mapas) + 
  geom_polygon(aes(x = long, y = lat, fill = D2040, group = group), color = "white") + 
  coord_fixed(1.3) +
  scale_fill_gradient(low = "red", high = "green") +
  ggtitle("Población 2040")

ggplot(data = mapas) + 
  geom_polygon(aes(x = long, y = lat, fill = D2050, group = group), color = "white") + 
  coord_fixed(1.3) +
  scale_fill_gradient(low = "red", high = "green") +
  ggtitle("Población 2050")

ggplot(data = mapas) + 
  geom_polygon(aes(x = long, y = lat, fill = D2060, group = group), color = "white") + 
  coord_fixed(1.3) +
  scale_fill_gradient(low = "red", high = "green") +
  ggtitle("Población 2060")

ggplot(data = mapas) + 
  geom_polygon(aes(x = long, y = lat, fill = D2070, group = group), color = "white") + 
  coord_fixed(1.3) +
  scale_fill_gradient(low = "red", high = "green") +
  ggtitle("Población 2070")

Conclusión

Se puede observar cómo dentro de la primera década Pennsylvania lidera entre los 5 estados. Sin embargo, conforme pasan los años los estados de North Carolina y Georgia lo sobrepasan, volviéndose éstos los más poblados. Por otro lado, el estado de Illinois comienza siendo el segundo estado con mayor población, pero va decrementando hasta convertirse en el estado con menos población. Por último, el estado de Ohio mantiene su posición como uno de los estados con menor población durante los años.