Cálculo de movilidad por departamento de la provincia

Input inicial - Imagenes rasters .tif de cambio porcentual semanal y prepandemia para locación, dia y horario reportado generadas en ‘Creacion de rasters’.

Objetivo - Obtener un dataset con los valores promedio de movilidad ciudadana tanto para cambio porcentual semanal como prepandemia, en cada locación y momento en el que haya disponible una imagen raster. - Nueva variable que promedie los valores de cambio porcentual semanal como prepandemia para mañana y tarde, ya que se asume que deberían ser similares.

1. Guardo información de los rasters en un dataset

Genero una base de datos con los polígonos de los departamentos de provincia de Buenos Aires y la ubicación de los archivos en el sistema.

# Leo todos los archivos de la carpeta
all_files <- list.files("data/inicial/")

# Filtro los archivos que terminan con '.tif'
base_raster <- all_files[grep(".tif$",
                              basename(all_files))]  |>
  tibble::as_tibble() |>
  tidyr::separate(value,
                  into = c('locacion',
                           'tipo_de_raster',
                           'fecha',
                           'hora'),
                  sep = '_',
                  remove = FALSE) |>
  dplyr::mutate(fecha = as.Date(fecha),
                hora = as.numeric(str_sub(hora, end= -4))) |>
  dplyr::mutate(momento = dplyr::case_when(hora == 0 ~ "noche",
                                           hora == 8 ~ "mañana",
                                           hora == 16 ~ "tarde"))

# Format the date to "YYYY-MM-DD" format
formatted_date <- format("2020-05-10", format = "%Y-%m-%d")

bsas <-  sf::st_read("data/procesada/bsas_caba_simple.gpkg")

Reading layer `bsas_caba_simple' from data source 
  `/Users/florenciadandrea/geocovid_bsas/data/procesada/bsas_caba_simple.gpkg' 
  using driver `GPKG'
Simple feature collection with 136 features and 1 field
Geometry type: POLYGON
Dimension:     XY
Bounding box:  xmin: -63.38597 ymin: -41.03785 xmax: -56.66503 ymax: -33.26185
Geodetic CRS:  WGS 84

base_raster_baires <- base_raster |>
  dplyr::filter(locacion == 'baires') |> #elimina valores de amba que coinciden
  dplyr::cross_join(bsas) |>
  dplyr::mutate(file = paste0('data/inicial/', value)) |>
  sf::st_as_sf()

2. Promedio de valores de movilidad ciudadana por departamento de Bs. As.

Esto lo realizamos tanto para los rasters de 0 am (noche), 8 am (mañana) y tarde (4 pm).
Se crea una variable, px_mean_dianoche, que promedia los valores de mañana (8 am) y tarde (4 pm).

px_baires <- c()

for(i in 1:nrow(base_raster_baires)){


  # cada fila corresponde a un partido diferente
  poli <- sf::st_as_sf(base_raster_baires[i, c('partido','geom')]) |>
    st_transform(3857)
  
  # si bien el raster va a ser el mismo en muchos casos
  raster <- terra::rast(base_raster_baires$file[i])
  crs(raster) <-  "epsg:3857"


  int_data2 <- terra::extract( raster,
                               sf::st_as_sf(poli),
                               fun = mean,
                               na.rm = TRUE)


  px_data <- data.frame(base_raster_baires[i,],
                        'px_mean' = int_data2[[2]] 
                        )

  px_baires <- rbind(px_data, px_baires)
}

px_baires_w <- px_baires |>
  select(fecha, locacion, tipo_de_raster, 
         momento, hora, partido, px_mean, geom) |>
  pivot_wider(
    names_from = c(momento, hora),
    values_from = px_mean) |> # esto habria que
  mutate(px_mean_dianoche = ((mañana_8 + tarde_16)/2))


px_baires_w

# A tibble: 272 × 9
   fecha      locacion tipo_de_raster partido                      geom mañana_8
   <date>     <chr>    <chr>          <chr>               <POLYGON [°]>    <dbl>
 1 2020-05-06 baires   pc             Capita… ((-58.44692 -34.68878, -…    -8.45
 2 2020-05-06 baires   pc             Avella… ((-58.27964 -34.67864, -…     5.46
 3 2020-05-06 baires   pc             Lomas … ((-58.34696 -34.73934, -…     5.10
 4 2020-05-06 baires   pc             Lanús   ((-58.40254 -34.65999, -…     5.16
 5 2020-05-06 baires   pc             Pergam… ((-60.45691 -33.59848, -…     4.59
 6 2020-05-06 baires   pc             Floren… ((-62.34816 -34.65378, -…     2.89
 7 2020-05-06 baires   pc             San Pe… ((-59.80947 -33.58342, -…     3.97
 8 2020-05-06 baires   pc             Barade… ((-59.22272 -33.81343, -…     4.05
 9 2020-05-06 baires   pc             Corone… ((-61.72849 -38.65709, -…     5.73
10 2020-05-06 baires   pc             Patago… ((-63.38327 -39.32849, -…     4.29
# ℹ 262 more rows
# ℹ 3 more variables: tarde_16 <dbl>, noche_0 <dbl>, px_mean_dianoche <dbl>

Las variables px_mean_dianoche y noche_0 se convierten en categóricas.

  px_bsas <-  px_baires_w  |>
         dplyr::filter(fecha == '2020-05-06',
                      tipo_de_raster == 'pc'
                      ) |>
         dplyr::mutate(criterio = case_when(px_mean_dianoche > 40 ~ "mas de 40",
                                     40 > px_mean_dianoche &
                                       px_mean_dianoche > 30 ~ "40 - 30",
                                     30 > px_mean_dianoche &
                                       px_mean_dianoche > 20 ~ "30 - 20",
                                     20 > px_mean_dianoche &
                                       px_mean_dianoche > 10 ~ "20 - 10",
                                     10 > px_mean_dianoche & 
                                       px_mean_dianoche > 1 ~ "10 - 1",
                                     1 > px_mean_dianoche &
                                       px_mean_dianoche> -1 ~ "sin cambios",
                                     -1 > px_mean_dianoche& 
                                       px_mean_dianoche > -10 ~ "-1 - -10",
                                     -10 > px_mean_dianoche& 
                                       px_mean_dianoche > -20 ~ "-10 - -20",
                                     -20 > px_mean_dianoche& 
                                       px_mean_dianoche > -30 ~ "-20 - -30",
                                     -30 > px_mean_dianoche& 
                                       px_mean_dianoche > -40 ~ "-30 - -40",
                                     -40 > px_mean_dianoche  ~ "menor a -40"),
         criterio_noche = case_when(noche_0 > 40 ~ "mas de 40",
                                     40 > noche_0 &
                                       noche_0 > 30 ~ "40 - 30",
                                     30 > noche_0 &
                                       noche_0 > 20 ~ "30 - 20",
                                     20 > noche_0 &
                                       noche_0 > 10 ~ "20 - 10",
                                     10 > noche_0 &
                                       noche_0 > 1 ~ "10 - 1",
                                     1 > noche_0 &
                                       noche_0> -1 ~ "sin cambios",
                                     -1 > noche_0 &
                                       noche_0 > -10 ~ "-1 - -10",
                                     -10 > noche_0 &
                                       noche_0 > -20 ~ "-10 - -20",
                                     -20 > noche_0 &
                                       noche_0 > -30 ~ "-20 - -30",
                                     -30 > noche_0 &
                                       noche_0 > -40 ~ "-30 - -40",
                                     -40 > noche_0  ~ "menor a -40")) |>
         dplyr::mutate(criterio = fct_relevel(criterio, c("mas de 40", 
                                                   "40 - 30",
                                                   "30 - 20",
                                                   "20 - 10","10 - 1",
                                                   "sin cambios",
                                                   "-1 - -10", 
                                                   "-10 - -20",
                                                   "-20 - -30", 
                                                   "-30 - -40",
                                                   "menor a -40")),
                criterio_noche = fct_relevel(criterio_noche, 
                                             c("mas de 40", 
                                                   "40 - 30",
                                                   "30 - 20",
                                                   "20 - 10",
                                                   "10 - 1",
                                                   "sin cambios",
                                                   "-1 - -10", 
                                                   "-10 - -20",
                                                   "-20 - -30", 
                                                   "-30 - -40",
                                                   "menor a -40"))) |>
  st_as_sf()

Warning: There were 2 warnings in `dplyr::mutate()`.
The first warning was:
ℹ In argument: `criterio = fct_relevel(...)`.
Caused by warning:
! 4 unknown levels in `f`: mas de 40, 40 - 30, 30 - 20, and -20 - -30
ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.

3. Mapa de provincia de Buenos Aires

# escala de color por categoria

  colors <- c("mas de 40"="#67001F",
              "40 - 30"="#B2182B",
              "30 - 20"="#D6604D",
              "20 - 10"="#F4A582",
              "10 - 1"="#FDDBC7",
              "sin cambios"="#F7F7F7",
              "-1 - -10" ="#D1E5F0",
              "-10 - -20"="#92C5DE",
              "-20 - -30"="#4393C3",
              "-30 - -40"="#2166AC",
              "menor a -40"="#053061")


 plotly::plot_ly() |>
   plotly::add_sf(stroke = I("#95B2C6"),
          data = px_bsas,
          split = ~criterio,
          name = ~criterio,
          color = ~criterio,
          colors = colors,
          stroke = I("transparent"),
          hoveron = "fills",
          hoverinfo = 'name',
          legendgroup = 'criterio',
          legendgrouptitle = list(text = 'Promedio % de cambio',
                                  font = list(size = 15,
                                  family = "Work Sans",
                                  color = "black"))
   )

No trace type specified:
  Based on info supplied, a 'scatter' trace seems appropriate.
  Read more about this trace type -> https://plotly.com/r/reference/#scatter