Actividad Integradora

Astrid Paola González díaz

2024-02-21

| 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
## 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
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
    
    # Plots
    plot<- plot(pronostico)
    
    resultados_plot[[i]] <-plot
    
}

Consolidación de los modelos

state_forecast<- do.call(rbind, resultados_pronosticos)

head(state_forecast)
##   Year Population State
## 1 1950     135000    AK
## 2 1951     158000    AK
## 3 1952     189000    AK
## 4 1953     205000    AK
## 5 1954     215000    AK
## 6 1955     222000    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 desarolló una aplicación de Shiny que permitía visualizar año con año los valores reales y la predicción a partir de 2020. Por cuestiones técnidas donde ShinyApp.io no me permitía acceder al servidor para poder publicar la aplicación decido anexar una imagen de como se visualizaba en shiny.

Se anexa un video de su utilización: https://youtu.be/6qDSOhQzmk0