Análisis de movilidad regional usando datos de "google mobility report"

library(pacman)
p_load("DT", "tidyverse", "readr", "gridExtra")

DatosMobilityReport <- read_csv("sonora3.csv")
## Parsed with column specification:
## cols(
##   country_region_code = col_character(),
##   country_region = col_character(),
##   sub_region_1 = col_character(),
##   sub_region_2 = col_logical(),
##   metro_area = col_logical(),
##   iso_3166_2_code = col_character(),
##   census_fips_code = col_logical(),
##   date = col_character(),
##   retail_and_recreation_percent_change_from_baseline = col_double(),
##   grocery_and_pharmacy_percent_change_from_baseline = col_double(),
##   parks_percent_change_from_baseline = col_double(),
##   transit_stations_percent_change_from_baseline = col_double(),
##   workplaces_percent_change_from_baseline = col_double(),
##   residential_percent_change_from_baseline = col_double()
## )
  • Hacer data table para mirar los datos
datatable(DatosMobilityReport)
  • Hacer las diferentes gráficas
##
Retail_Recreation_Percentage <- DatosMobilityReport$retail_and_recreation_percent_change_from_baseline
###
Grocery_Pharmacy_Percentage <-  DatosMobilityReport$grocery_and_pharmacy_percent_change_from_baseline
###
Parks_Percentage <- DatosMobilityReport$parks_percent_change_from_baseline
###
TransitStations_Percentage <- DatosMobilityReport$transit_stations_percent_change_from_baseline
###
Workplaces_Percentage <- DatosMobilityReport$workplaces_percent_change_from_baseline
###
Residential_Percentage <- DatosMobilityReport$residential_percent_change_from_baseline

##Renombrar variables de interes para facilitas al momento de llamarlas

###
Porcentaje_VR <- DatosMobilityReport$retail_and_recreation_percent_change_from_baseline
###
Porcentaje_F <-  DatosMobilityReport$grocery_and_pharmacy_percent_change_from_baseline
###
Porcentaje_P <- DatosMobilityReport$parks_percent_change_from_baseline
###
Porcentaje_ET <- DatosMobilityReport$transit_stations_percent_change_from_baseline
###
Porcentaje_AT <- DatosMobilityReport$workplaces_percent_change_from_baseline
###
Porcentaje_H <- DatosMobilityReport$residential_percent_change_from_baseline

# Data frame

FechaMR = seq(from = as.Date("2019-02-15"), to = as.Date("2019-10-14"), by = 'day')

dataMR <- data.frame(x=FechaMR,y=Retail_Recreation_Percentage)
  • Gráficas
gMR1 <- ggplot(data=dataMR) +
  geom_line(aes(x=FechaMR, y=Porcentaje_VR), size=1, colour="orange") +
  geom_hline(yintercept = 0) +
  theme_light() +
  xlab("Fecha") +
  ylab("Porcentaje") +
  ggtitle("a) Comercio y recreación (-45%)")
gMR2 <- ggplot(data=dataMR) +
  geom_line(aes(x=FechaMR, y=Porcentaje_F), size=1, colour="darkgreen") +
  geom_hline(yintercept = 0) +
  theme_light() +
  xlab("Fecha") +
  ylab("Porcentaje") +
  ggtitle("b) Farmacias y abarrotes (-11%)")

gMR3 <- ggplot(data=dataMR) +
  geom_line(aes(x=FechaMR, y=Porcentaje_P), size=1, colour="purple") +
  geom_hline(yintercept = 0) +
  theme_light() +
  xlab("Fecha") +
  ylab("Porcentaje") +
  ggtitle("c) Parques (-37%)")

gMR4 <- ggplot(data=dataMR) +
  geom_line(aes(x=FechaMR, y=Porcentaje_ET), size=1, colour="brown") +
  geom_hline(yintercept = 0) +
  theme_light() +
  xlab("Fecha") +
  ylab("Porcentaje") +
  ggtitle("d) Estaciones de tránsito (-43%)")

gMR5 <- ggplot(data=dataMR) +
  geom_line(aes(x=FechaMR, y=Porcentaje_AT), size=1, colour="red") +
  geom_hline(yintercept = 0) +
  theme_light() +
  xlab("Fecha") +
  ylab("Porcentaje") +
  ggtitle("e) Espacios de trabajo (-37%)")

gMR6 <- ggplot(data=dataMR) +
  geom_line(aes(x=FechaMR, y=Porcentaje_H), size=1, colour="blue") +
  geom_hline(yintercept = 0) +
  theme_light() +
  xlab("Fecha") +
  ylab("Porcentaje") +
  ggtitle("f) Hogares (+18%)")
grid.arrange(gMR1,gMR2,gMR3,gMR4,gMR5,gMR6)

Preguntas a contestar

¿Ocurrió algo importante entre el 3 de enero y el 6 de febrero del 2020?

  • Tomando encuenta este análisis estadístico, no se puede determinar que algo importante hubiese pasado en essas fechas, por el hecho de que nustro análisis solo esta tomando las fechas que comprenden del 15 de Febrero al 14 de Octubre del presente año. A tráves de una busqueda rápida de internet se encontraron estos sucesos para México 3 de enero: En la Ciudad de México, se activa la alerta sísmica derivado de un error de pruebas de audio, dejando únicamente crisis nerviosa. 4 de enero: Se registra un temblor con magnitud 6.0 en la escala Richter con epicentro a 38 kilómetros al suroeste de Unión Hidalgo, Oaxaca. 10 de enero: Tiroteo en el Colegio Cervantes de Torreón. 17 de enero: Masacre de Chilapa. Secretaría de Gobernación anuncia la construcción de un memorial en honor a los fallecidos de la explosión de Tlahuelilpan de 2019.

¿Hubo un invierno frío o un verano más largo de lo habitual en tu región?

  • El invierno duro un poco más de lo usual pero no se puede ver reflejado tal cual en las gráficas, ya que ninguna ralaciona tal cual lo que son las temporadas con las variables manejadas, ya que estas estan encaminadas a lo de la pandemia Covid-19.

¿Los festivos cayeron el mismo día de la semana?

¿Tienes otras fuentes de datos (como tiques de peajes, parquímetros o viajes en metro) que puedan ayudarte a determinar el cambio previsto?

  • Por mi parte no, pero mis padres deben de tener tiquets de compras en las cuales se pdría ver reflejado el iniicio de la pandemia, ya que cuando se declaro que no se volvería a clases, ellos hicieron compras de para las necesidades diarias.