U1A13
Daniel Quintana
19/10/2020
Importar Datos
library(readr)
library(DT)
Reportes <- read_csv("Mobility_Report2020Mexico.csv")##
## -- 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_date(format = ""),
## 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()
## )Reportes## # A tibble: 7,986 x 14
## country_region_~ country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 MX Mexico <NA> NA NA
## 2 MX Mexico <NA> NA NA
## 3 MX Mexico <NA> NA NA
## 4 MX Mexico <NA> NA NA
## 5 MX Mexico <NA> NA NA
## 6 MX Mexico <NA> NA NA
## 7 MX Mexico <NA> NA NA
## 8 MX Mexico <NA> NA NA
## 9 MX Mexico <NA> NA NA
## 10 MX Mexico <NA> NA NA
## # ... with 7,976 more rows, and 9 more variables: iso_3166_2_code <chr>,
## # census_fips_code <lgl>, date <date>,
## # retail_and_recreation_percent_change_from_baseline <dbl>,
## # grocery_and_pharmacy_percent_change_from_baseline <dbl>,
## # parks_percent_change_from_baseline <dbl>,
## # transit_stations_percent_change_from_baseline <dbl>,
## # workplaces_percent_change_from_baseline <dbl>,
## # residential_percent_change_from_baseline <dbl>*un analisis de regresion logistica
colores <- NULL
colores[Reportes$residential_percent_change_from_baseline == -1] <- "green"
colores[Reportes$residential_percent_change_from_baseline == -2] <- "red"
plot(Reportes$residential_percent_change_from_baseline,Reportes$workplaces_percent_change_from_baseline, pch=21, bg=colores)
reg <- glm( workplaces_percent_change_from_baseline ~ residential_percent_change_from_baseline , data = Reportes)
summary(reg)##
## Call:
## glm(formula = workplaces_percent_change_from_baseline ~ residential_percent_change_from_baseline,
## data = Reportes)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -64.005 -4.896 -0.957 4.213 38.839
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.95724 0.17453 28.4 <2e-16
## residential_percent_change_from_baseline -2.42180 0.01206 -200.8 <2e-16
##
## (Intercept) ***
## residential_percent_change_from_baseline ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 60.08583)
##
## Null deviance: 2903189 on 7985 degrees of freedom
## Residual deviance: 479725 on 7984 degrees of freedom
## AIC: 55376
##
## Number of Fisher Scoring iterations: 2datos <- data.frame(residential_percent_change_from_baseline = seq(12))
#Es una variable que hace una prediccion en funcion del modelo regresion en el modelo de
probabilidades <- predict(reg,datos,type = "response")
plot(Reportes$residential_percent_change_from_baseline,Reportes$workplaces_percent_change_from_baseline, pch=21, bg=colores)
##Mostrar las columnas
names(Reportes)## [1] "country_region_code"
## [2] "country_region"
## [3] "sub_region_1"
## [4] "sub_region_2"
## [5] "metro_area"
## [6] "iso_3166_2_code"
## [7] "census_fips_code"
## [8] "date"
## [9] "retail_and_recreation_percent_change_from_baseline"
## [10] "grocery_and_pharmacy_percent_change_from_baseline"
## [11] "parks_percent_change_from_baseline"
## [12] "transit_stations_percent_change_from_baseline"
## [13] "workplaces_percent_change_from_baseline"
## [14] "residential_percent_change_from_baseline"###Visualizar
head(Reportes)## # A tibble: 6 x 14
## country_region_~ country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 MX Mexico <NA> NA NA
## 2 MX Mexico <NA> NA NA
## 3 MX Mexico <NA> NA NA
## 4 MX Mexico <NA> NA NA
## 5 MX Mexico <NA> NA NA
## 6 MX Mexico <NA> NA NA
## # ... with 9 more variables: iso_3166_2_code <chr>, census_fips_code <lgl>,
## # date <date>, retail_and_recreation_percent_change_from_baseline <dbl>,
## # grocery_and_pharmacy_percent_change_from_baseline <dbl>,
## # parks_percent_change_from_baseline <dbl>,
## # transit_stations_percent_change_from_baseline <dbl>,
## # workplaces_percent_change_from_baseline <dbl>,
## # residential_percent_change_from_baseline <dbl>*Matriz de diagramas de dispersión
pairs(Reportes[9:14])
A continuacion se hara una cuantificacion del grado de relacion lineal, por medio de la matriz de coeficientes de correlacion
cor(Reportes[9:14])## retail_and_recreation_percent_change_from_baseline
## retail_and_recreation_percent_change_from_baseline 1.0000000
## grocery_and_pharmacy_percent_change_from_baseline 0.8599012
## parks_percent_change_from_baseline 0.9265364
## transit_stations_percent_change_from_baseline NA
## workplaces_percent_change_from_baseline 0.6866173
## residential_percent_change_from_baseline -0.8594864
## grocery_and_pharmacy_percent_change_from_baseline
## retail_and_recreation_percent_change_from_baseline 0.8599012
## grocery_and_pharmacy_percent_change_from_baseline 1.0000000
## parks_percent_change_from_baseline 0.8495828
## transit_stations_percent_change_from_baseline NA
## workplaces_percent_change_from_baseline 0.6148245
## residential_percent_change_from_baseline -0.7434494
## parks_percent_change_from_baseline
## retail_and_recreation_percent_change_from_baseline 0.9265364
## grocery_and_pharmacy_percent_change_from_baseline 0.8495828
## parks_percent_change_from_baseline 1.0000000
## transit_stations_percent_change_from_baseline NA
## workplaces_percent_change_from_baseline 0.6652037
## residential_percent_change_from_baseline -0.8265626
## transit_stations_percent_change_from_baseline
## retail_and_recreation_percent_change_from_baseline NA
## grocery_and_pharmacy_percent_change_from_baseline NA
## parks_percent_change_from_baseline NA
## transit_stations_percent_change_from_baseline 1
## workplaces_percent_change_from_baseline NA
## residential_percent_change_from_baseline NA
## workplaces_percent_change_from_baseline
## retail_and_recreation_percent_change_from_baseline 0.6866173
## grocery_and_pharmacy_percent_change_from_baseline 0.6148245
## parks_percent_change_from_baseline 0.6652037
## transit_stations_percent_change_from_baseline NA
## workplaces_percent_change_from_baseline 1.0000000
## residential_percent_change_from_baseline -0.9136516
## residential_percent_change_from_baseline
## retail_and_recreation_percent_change_from_baseline -0.8594864
## grocery_and_pharmacy_percent_change_from_baseline -0.7434494
## parks_percent_change_from_baseline -0.8265626
## transit_stations_percent_change_from_baseline NA
## workplaces_percent_change_from_baseline -0.9136516
## residential_percent_change_from_baseline 1.0000000###Grafica de la recta de minimos cuadrados
plot(Reportes$residential_percent_change_from_baseline,Reportes$workplaces_percent_change_from_baseline, xlab = "residential_percent", ylab="workplaces_percent")
abline(reg)
### Modelacion (calculo) de predicciones
Predicc <-data.frame(residential_percent_change_from_baseline=seq(0,30))
predict(reg,Predicc)## 1 2 3 4 5 6
## 4.9572387 2.5354348 0.1136309 -2.3081730 -4.7299769 -7.1517808
## 7 8 9 10 11 12
## -9.5735847 -11.9953885 -14.4171924 -16.8389963 -19.2608002 -21.6826041
## 13 14 15 16 17 18
## -24.1044080 -26.5262119 -28.9480157 -31.3698196 -33.7916235 -36.2134274
## 19 20 21 22 23 24
## -38.6352313 -41.0570352 -43.4788390 -45.9006429 -48.3224468 -50.7442507
## 25 26 27 28 29 30
## -53.1660546 -55.5878585 -58.0096624 -60.4314662 -62.8532701 -65.2750740
## 31
## -67.6968779Intervalo de confianza
confint(reg)## Waiting for profiling to be done...## 2.5 % 97.5 %
## (Intercept) 4.615162 5.299316
## residential_percent_change_from_baseline -2.445439 -2.398169Todo esto sirve para modelar