TP5: Analizando y visualizando flujos de viajes urbanos

##Tema B

#Consigna:

Elegir un dataset que contenga servicios esenciales (hospitales, escuelas, comisarías, etc) de la Ciudad con la que están trabajando. En este caso deberán elegir un barrio céntrico y uno periférico del shape de barrios y calcular ambos centroides.Los datos pueden ser descargados del portal open data de la ciudad o de OSM y deben tener ubicación geográfica.

Antes de iniciar el trabajo cargamos las librerias que vamos a utilizar.

library(osmdata)
library(tidyverse)
library(sf)
library(leaflet)
library(osrm)

A continuacion cargamos el shapefile que contiene la informacion de todos los barrios de Nueva york y descargamos a traves de la funcion “bbox” la informacion y forma de los barrios de Queens y Brooklyn.

barriosny <- st_read("/Users/nadia/Downloads/calles/geo_export_649ee37c-c670-4e7b-a946-117e66bfafd1.shp")

Trabajamos por partes, primero nos concentramos en Queens

bbox_stQ <- getbb('queens, new york')

bbox_st_polyQ = getbb('queens, new york', format_out = "sf_polygon")

leaflet(bbox_st_polyQ) %>%
  addTiles() %>%
  addPolygons()

Descargamos la informacion sobre las calles del barrio en cuestion y luego sobre los servicios esenciales elegidos, para este trabajo practico utilizaremos el listado de hospitales.

Queens_calles <- opq(bbox_stQ) %>%
    add_osm_feature(key = "highway") %>%
    osmdata_sf()
hospitalQueens <- opq(bbox_stQ) %>%
  add_osm_feature(key = "amenity", value = "hospital") %>%
  osmdata_sf()

Limitamos las calles al poligono obtenido de Queens:

Queens_calles2 <- st_intersection(Queens_calles$osm_lines, bbox_st_polyQ)
## although coordinates are longitude/latitude, st_intersection assumes that they are planar
## Warning: attribute variables are assumed to be spatially constant
## throughout all geometries

Limitamos los hospitales al poligono obtenido de Queens::

hospitalQueens2 <- st_intersection(hospitalQueens$osm_points, bbox_st_polyQ)

Luego aplicamos el mismo procedimiento para el barrio de Brooklyn

bbox_stBro <- getbb('brooklyn, new york')

bbox_st_polyBro = getbb('brooklyn, new york', format_out = "sf_polygon")

leaflet(bbox_st_polyBro) %>%
  addTiles() %>%
  addPolygons()

Descargamos las calles:

Brooklyn_calles <- opq(bbox_stBro) %>%
    add_osm_feature(key = "highway") %>%
    osmdata_sf()

Descargamos los hospitales:

hospitalBrooklyn <- opq(bbox_stBro) %>%
  add_osm_feature(key = "amenity", value = "hospital") %>%
  osmdata_sf()

Limitamos las calles al poligono obtenido de Brooklyn:

Brooklyn_calles2 <- st_intersection(Brooklyn_calles$osm_lines, bbox_st_polyBro)

Limitamos los hospitales al poligono obtenido de -Brooklyn:

hospitalBrooklyn2 <- st_intersection(hospitalBrooklyn$osm_points, bbox_st_polyBro)

Graficamos para confirmar que las operaciones anteriores fueron correctas.

ggplot() +
  geom_sf(data = Queens_calles2,
            color = "darkslateblue") +
    geom_sf(data = Brooklyn_calles2,
            color = "darkslateblue") +
  geom_sf(data = hospitalQueens2, color = "red") +
  geom_sf(data = hospitalBrooklyn2, color = "red")

Luego calculamos los centroides de ambos barrios

barriosnyBro <- barriosny %>%
    group_by(borocode)%>%
  filter(borocode %in% c("3"))

barriosnyBro2 <- barriosnyBro%>% summarise(cantidad = n())
sf_centBro <- st_centroid(barriosnyBro2)

Repetimos el proceso para Queens

barriosQueens <- barriosny %>%
    group_by(borocode)%>%
  filter(borocode %in% c("4"))

barriosQueens2 <- barriosQueens%>% summarise(cantidad = n())
sf_centQueens <- st_centroid(barriosQueens2)

Finalmente graficamos

ggplot() +
      geom_sf(data = barriosQueens2,
            color = "green", size = 1, fill="transparent") +
   geom_sf(data = barriosnyBro2,
            color = "green", size = 1, fill="transparent") +
      geom_sf(data = Queens_calles2,
            color = "gray50", alpha = 0.5) +
    geom_sf(data = Brooklyn_calles2,
            color = "gray50", alpha = 0.5) +
  geom_sf(data = hospitalQueens2, color = "red") +
  geom_sf(data = hospitalBrooklyn2, color = "red") +
   geom_sf(data = sf_centBro, color = 'yellow') +
   geom_sf(data = sf_centQueens, color = 'yellow') +
  theme_void() +
  labs (title = "Brooklyn y Queens",
       subtitle = "Servicios escenciales: Hospitales y centroides de los respectivos barrios")

#Parte 2

Consigna para tema B (Servicios esenciales): Estimar la distancia entre los centroides calculados en el punto I y los ítems que componen la capa descargada. Describir los resultados obtenidos y hacer los siguientes mapas: Mapa con los ruteos del centroide del barrio céntrico a los ítems de servicios esenciales elegido y Mapa con los ruteos del centroide del barrio periférico a los ítems de servicios esenciales elegido. De manera de comenzar esta segunda parte del trabajo practico, cargamos nuevamente las librerias que vamos a utilizar.

Convertimos la geometria en coordenadas (latitud y longitud) ya que mas adelante sera necesario.

hospitalBrooklyn4<- hospitalBrooklyn2%>%
    mutate(lon = unlist(map(hospitalBrooklyn2$geometry,1)),
           lat = unlist(map(hospitalBrooklyn2$geometry,2)))

hospitalQueens4<- hospitalQueens2%>%
    mutate(lon = unlist(map(hospitalQueens2$geometry,1)),
           lat = unlist(map(hospitalQueens2$geometry,2)))

Nos concentramos en el shapefile de los barrios de nueva york, filtrando por borough code (codigo de boro) de manera de tener solamente Queens y Brooklyn.

barriosnyBro <- barriosny%>%
    group_by(borocode)%>%
  filter(borocode%in% c("3"))

barriosnyBro2 <- barriosnyBro%>% summarise(cantidad = n())

barriosnyQ <- barriosny%>%
    group_by(borocode)%>%
  filter(borocode%in% c("4"))

barriosnyQ <- barriosnyQ%>% summarise(cantidad = n())

En base al paso anterior calculamos los respectivos centroides.

sf_centBro <- st_centroid(barriosnyBro2)
sf_centQ   <-st_centroid(barriosnyQ)

Agrego las coordenadas (longitud y latitud) a la tabla, y agrego ademas agrego una columna indicado el borough.

Convierto la tabla resultante a un dataframe y hago luego una union entre la tabla de hospitales y de centroides mediante la columna de borough code.

El resultado es un dataframe donde estan nombre de origen fijo, latitud y longitud de origen fijos, y los destinos con sus nombre, latitud y longitud.

sf_centBro<-sf_centBro %>%
   mutate(lon1 = unlist(map(sf_centBro$geometry,1)),
           lat1 = unlist(map(sf_centBro$geometry,2)))
centrf<-as.data.frame(sf_centBro)

hospitalBrooklyn4<- hospitalBrooklyn4%>%
    mutate(lon = unlist(map(hospitalBrooklyn4$geometry,1)),
           lat = unlist(map(hospitalBrooklyn4$geometry,2)))

hospitalBrooklyn4$borocode<-"3"
#######################################
sf_centQ<-sf_centQ %>%
   mutate(lon1 = unlist(map(sf_centQ$geometry,1)),
           lat1 = unlist(map(sf_centQ$geometry,2)))
centrq<-as.data.frame(sf_centQ)
centrq$borocode<-"4"

hospitalQueens4<- hospitalQueens4%>%
    mutate(lon = unlist(map(hospitalQueens4$geometry,1)),
           lat = unlist(map(hospitalQueens4$geometry,2)))

hospitalQueens4$borocode<-"4"

##############################################


h4 <- hospitalBrooklyn4 %>%
  mutate(ORIGEN="BROOKLYN") %>%
  left_join(centrf, by="borocode") %>%
  rename(NOMBRE_ORIGEN=ORIGEN,
          LON_ORIGEN= lon1,
          LAT_ORIGEN= lat1,
         
         NOMBRE_DESTINO=osm_id,
         ) %>%
  select(NOMBRE_ORIGEN,LON_ORIGEN,LAT_ORIGEN, NOMBRE_DESTINO)
h4<-h4 %>%
   mutate(LON_DESTINO = unlist(map(h4$geometry,1)),
           LAT_DESTINO = unlist(map(h4$geometry,2)))
#####################################
h5 <- hospitalQueens4 %>%
  mutate(ORIGEN="QUEENS") %>%
  left_join(centrq, by="borocode") %>%
  rename(NOMBRE_ORIGEN=ORIGEN,
          LON_ORIGEN= lon1,
          LAT_ORIGEN= lat1,
         
         NOMBRE_DESTINO=osm_id,
         ) %>%
  select(NOMBRE_ORIGEN,LON_ORIGEN,LAT_ORIGEN, NOMBRE_DESTINO)
h5<-h5 %>%
   mutate(LON_DESTINO = unlist(map(h5$geometry,1)),
           LAT_DESTINO = unlist(map(h5$geometry,2)))

La siguiente funcion permite hacer en forma repetitiva la ruta para cada fila de ese dataframe.

ruteo_a_hospitales <- function(o_nombre, o_x, o_y, d_nombre, d_x, d_y) {
  library(osrm)
  ruta <- osrmRoute(src = c(o_nombre, o_x, o_y),
                    dst = c(d_nombre, d_x, d_y), 
                    returnclass = "sf",
                    overview = "full")
  
  cbind(ORIGEN = o_nombre, DESTINO = d_nombre, ruta)
  
}

Las matrices creadas para los barrios son procesadas por la funcion antes creada.

ruteo_b <- list(h4$NOMBRE_ORIGEN, h4$LON_ORIGEN,h4$LAT_ORIGEN,
                   h4$NOMBRE_DESTINO, h4$LON_DESTINO,h4$LAT_DESTINO)
ruteo_q <- list(h5$NOMBRE_ORIGEN, h5$LON_ORIGEN,h5$LAT_ORIGEN,
                   h5$NOMBRE_DESTINO, h5$LON_DESTINO,h5$LAT_DESTINO)

El resultado es la matriz de rutas entre el centroide y cada una de las facilidades.

ruteo_centrico <- pmap(ruteo_b, ruteo_a_hospitales) %>% 
  reduce(rbind)
ruteo_centrico <-mutate(ruteo_centrico, RUTA = paste(ORIGEN,"a", DESTINO)) 


ruteo_queens <- pmap(ruteo_q, ruteo_a_hospitales) %>% 
  reduce(rbind)
ruteo_queens <-mutate(ruteo_queens, RUTA = paste(ORIGEN,"a", DESTINO))

Finalmente con toda esta informacion, graficamos.

De manera de probar cual es la mejor forma de comunicar la informacion utilizamos dos provedores de mapas distintos (hacemos esto para ambos barrios)

leaflet(ruteo_centrico) %>%
  addTiles() %>%
  addProviderTiles(providers$CartoDB.DarkMatter) %>%
  addPolylines(color = ~colorNumeric("BrBG", ruteo_centrico$distance)(distance),
              label = ruteo_centrico$RUTA %>%
              lapply(htmltools::HTML)) %>%
  addLegend("bottomright", pal = colorNumeric("BrBG", ruteo_centrico$distance), values = ~distance,
            title = "Distancia",
            opacity = 0.55) 
leaflet(ruteo_queens) %>%
  addTiles() %>%
  addProviderTiles(providers$CartoDB.DarkMatter) %>%
  addPolylines(color = ~colorNumeric("BrBG", ruteo_queens$distance)(distance),
              label = ruteo_queens$RUTA %>%
              lapply(htmltools::HTML)) %>%
  addLegend("bottomright", pal = colorNumeric("BrBG", ruteo_queens$distance), values = ~distance,
            title = "Distancia",
            opacity = 0.55) 
leaflet(ruteo_queens) %>%
  addTiles() %>%
  addPolylines(color = ~colorNumeric("BrBG", ruteo_queens$distance)(distance),
              label = ruteo_queens$RUTA %>%
              lapply(htmltools::HTML)) 
leaflet(ruteo_centrico) %>%
  addTiles() %>%
  addPolylines(color = ~colorNumeric("BrBG", ruteo_centrico$distance)(distance),
              label = ruteo_centrico$RUTA %>%
              lapply(htmltools::HTML)) %>%
addLegend("bottomright", pal = colorNumeric("BrBG", ruteo_queens$distance), values = ~distance,
            title = "Distancia",
            opacity = 0.55)