class: center, middle, inverse, title-slide .title[ # Marijuana Arrests in Toronto: Racial Disparities ] .author[ ### Fernando José Álvarez Petro & Diego Andrés Moreno López ] .date[ ### 2023-05-26 ] --- ### Marijuana Arrests in Toronto: Racial Disparities * Base de datos recopilada como parte de un estudio sobre disparidades raciales en los arrestos por posesión de marihuana en Toronto. * Contiene 5226 observaciones y 8 variables. * Propósito: examinar el tratamiento policial de individuos arrestados por posesión simple de marihuana en la ciudad. --- ### Descripción de variables 1. released: Indica si la persona arrestada fue liberada con una citación. Categorías: "No" y "Yes". 2. colour: Representa la raza del individuo arrestado. Categorías: "Black" (negro) y "White" (blanco). 3. year: Indica el año del arresto. Rango: 1997-2002. 4. age: Edad de la persona arrestada en años. Variable numérica continua. 5. sex: Género de la persona arrestada. Categorías: "Female" (mujer) y "Male" (hombre). 6. employed: Indica si la persona arrestada está empleada. Categorías: "No" y "Yes". 7. citizen: Indica si la persona arrestada es ciudadana. Categorías: "No" y "Yes". 8. checks: Número de bases de datos policiales en las que aparece el nombre del arrestado. Variable numérica continua. --- ### Paquetes ```r library(tidyverse) library(plotly) library(leaps) library(MASS) ``` ### Exportar archivo ```r #file.choose() datos <- read.csv("C:\\Users\\ferna\\OneDrive - UPB\\Documents\\Upb\\Semestre 9\\Ciencia de datos\\FINAL PROJECT\\Arrests.csv") ``` --- ### Acercamiento a la base de datos ```r head(datos) ``` ``` ## X released colour year age sex employed citizen checks ## 1 1 Yes White 2002 21 Male Yes Yes 3 ## 2 2 No Black 1999 17 Male Yes Yes 3 ## 3 3 Yes White 2000 24 Male Yes Yes 3 ## 4 4 No Black 2000 46 Male Yes Yes 1 ## 5 5 Yes Black 1999 27 Female Yes Yes 1 ## 6 6 Yes Black 1998 16 Female Yes Yes 0 ``` ```r datos <- datos %>% rename( observación = X, detenido = released, color_piel = colour, año = year, edad = age, sexo = sex, empleado = employed, ciudadano = citizen, n_arrestos = checks ) ``` --- ### Transformación de datos ```r datos <- datos %>% mutate( capturas = ifelse(n_arrestos >= 3 & detenido == "No", "Investigar", "No investigar") ) ``` --- ### EDA Se realiza un analisis exploratorio a los datos con el fin de explorar el comportamiento individual y en conjunto de algunas varible. ```r g1 <- ggplot(datos, aes(x = color_piel, fill = detenido)) + geom_bar(position = "dodge") + labs(x = "Color de piel", y = "Número de observaciones", fill = "Detenido", title = "Personas detenidas vs Raza") ggplotly(g1) ```
--- ```r g2 <- ggplot(datos, aes(x = edad)) + geom_bar(position = "dodge") + labs(x = "Edad", y = "Número de observaciones", title = "Edad de las personas que portaban droga") ggplotly(g2) ```
--- ```r g3 <- ggplot(datos, aes(x = capturas)) + geom_bar(position = "dodge", fill = "red") + labs(x = "Capturas", y = "Número de observaciones", title = "Relación entre el número de arrestos y las personas detenidas") ggplotly(g3) ```
--- ```r g4 <- ggplot(data = datos, aes(x = año, y = edad)) + geom_point(col = "blue") + labs(x = "Año", y = "Edad", title = "Relación entre la edad de la persona vs año en que se presento") ggplotly(g4) ```
```r #cor.test(año, edad) ``` --- ```r g5 <- ggplot(datos, aes(x = n_arrestos)) + geom_density(aes(colour = detenido)) + labs(x = "Número de arrestos", y = "Número de observaciones", title = "Historial arrestos vs ultima detención") ggplotly(g5) ```
--- ```r g6 <- ggplot(datos, aes(x = edad, fill = as.character(datos$n_arrestos))) + geom_bar(position = "dodge") + labs(x = "Edad", y = "Número de observaciones", fill = "Número de arrestos", title = "Relación del número de arrestos vs edad de la persona") ggplotly(g6) ``` ``` ## Warning: Use of `datos$n_arrestos` is discouraged. ## ℹ Use `n_arrestos` instead. ```
--- ```r g7 <- ggplot(data = datos, aes(x = edad, y = n_arrestos)) + geom_point(col = "blue") + labs(x = "Edad", y = "Número de arrestos", title = "Relación del número de arrestos vs edad de la persona") ggplotly(g7) ```
```r #cor.test(edad, n_arrestos) ``` --- ```r g8 <- ggplot(data = datos, aes(x = año, y = n_arrestos)) + geom_point(col = "blue") + labs(x = "Año", y = "Número de arrestos", title = "Relación del número de arrestos vs año en que se presento") ggplotly(g8) ```
```r #cor.test(año, n_arrestos) ``` --- ```r g9 <- ggplot(data = datos, aes(x = año, y = edad)) + geom_point(col = "blue") + labs(x = "Año", y = "Edad", title = "Relación entre la edad de la persona vs año en que se presento") ggplotly(g9) ```
```r #cor.test(año, edad) ``` --- ## Transformación de variables ```r datos <- datos %>% mutate(across(c(detenido, color_piel, sexo, empleado, ciudadano, capturas), ~as.factor(.))) %>% mutate(across(c(detenido, color_piel, sexo, empleado, ciudadano, capturas), ~as.integer(.))) ``` --- ### Regresión ### Metodo de selección de variable ```r resultados <- numeric(9) for (i in 1:9) { mod_select <- regsubsets(x = n_arrestos ~ . , data = datos, nvmax = i, nbest = 1, method = "exhaustive") #Ajuste la variable salario con la restante que se encuentra en la base de datos Resumen <- summary(mod_select)$adjr2 resultados[i] <- Resumen[i] } mejor_i <- which.max(resultados) print(resultados) ``` ``` ## [1] 0.1854154 0.2122695 0.2241012 0.2370082 0.2456348 0.2533186 0.2545948 ## [8] 0.2553478 0.2553347 ``` ```r print(mejor_i) ``` ``` ## [1] 8 ``` ```r mod_select1 <- regsubsets(x = n_arrestos ~ . , data = datos, nvmax = mejor_i, nbest = 1, method = "exhaustive") #Ajuste la variable salario con la restante que se encuentra en la base de datos Resumen1 <- summary(mod_select)$adjr2 plot(mod_select1, scale = "adjr2") ``` <!-- --> --- ### Método forward ```r resultados2 <- numeric(8) for (i in 1:8) { mod_select2 <- regsubsets(x = n_arrestos ~ ., data = datos, nvmax = i, nbest = 1, method = "forward") res2 <- summary(mod_select2) } tb1 <- tibble(nvar = 1:8, r2adj1 = res2$adjr2, r21 = res2$rsq, cp1 = res2$cp, bic1 = res2$bic) res2$which ``` ``` ## (Intercept) observación detenido color_piel año edad sexo empleado ## 1 TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE ## 2 TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE ## 3 TRUE FALSE TRUE FALSE FALSE FALSE FALSE TRUE ## 4 TRUE FALSE TRUE TRUE FALSE FALSE FALSE TRUE ## 5 TRUE FALSE TRUE TRUE FALSE TRUE FALSE TRUE ## 6 TRUE FALSE TRUE TRUE FALSE TRUE TRUE TRUE ## 7 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE ## 8 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE ## ciudadano capturas ## 1 FALSE TRUE ## 2 FALSE TRUE ## 3 FALSE TRUE ## 4 FALSE TRUE ## 5 FALSE TRUE ## 6 FALSE TRUE ## 7 FALSE TRUE ## 8 TRUE TRUE ``` ```r Point <- tb1 %>% filter(r2adj1 == max(tb1$r2adj1)) ``` --- ### Método back ```r resultados2 <- numeric(8) for (i in 1:8) { mod_select4 <- regsubsets(x = n_arrestos ~ ., data = datos, nvmax = i, nbest = 1, method = "back") res4 <- summary(mod_select4) } tb4 <- tibble(nvar = 1:8, r2adj4 = res4$adjr2, r24 = res4$rsq, cp4 = res4$cp, bic4 = res4$bic) res4$which ``` ``` ## (Intercept) observación detenido color_piel año edad sexo empleado ## 1 TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE ## 2 TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE ## 3 TRUE FALSE TRUE FALSE FALSE FALSE FALSE TRUE ## 4 TRUE FALSE TRUE TRUE FALSE FALSE FALSE TRUE ## 5 TRUE FALSE TRUE TRUE FALSE TRUE FALSE TRUE ## 6 TRUE FALSE TRUE TRUE FALSE TRUE TRUE TRUE ## 7 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE ## 8 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE ## ciudadano capturas ## 1 FALSE TRUE ## 2 FALSE TRUE ## 3 FALSE TRUE ## 4 FALSE TRUE ## 5 FALSE TRUE ## 6 FALSE TRUE ## 7 FALSE TRUE ## 8 TRUE TRUE ``` ```r Point <- tb4 %>% filter(r2adj4 == max(tb4$r2adj4)) ``` --- ### Estimación del mejor modelo ```r mod1 <- lm(formula = n_arrestos ~ ., data = datos) summary(mod1) ``` ``` ## ## Call: ## lm(formula = n_arrestos ~ ., data = datos) ## ## Residuals: ## Min 1Q Median 3Q Max ## -2.7644 -1.1847 -0.2342 0.8594 4.4843 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 1.078e+02 2.745e+01 3.926 8.75e-05 *** ## observación -1.161e-05 1.219e-05 -0.953 0.340742 ## detenido 6.868e-01 7.222e-02 9.509 < 2e-16 *** ## color_piel -4.016e-01 4.434e-02 -9.057 < 2e-16 *** ## año -5.116e-02 1.374e-02 -3.722 0.000199 *** ## edad 1.758e-02 2.232e-03 7.874 4.14e-15 *** ## sexo 5.048e-01 6.636e-02 7.607 3.31e-14 *** ## empleado -6.089e-01 4.639e-02 -13.127 < 2e-16 *** ## ciudadano 1.394e-01 5.568e-02 2.504 0.012317 * ## capturas -2.591e+00 9.061e-02 -28.597 < 2e-16 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 1.328 on 5216 degrees of freedom ## Multiple R-squared: 0.2566, Adjusted R-squared: 0.2553 ## F-statistic: 200.1 on 9 and 5216 DF, p-value: < 2.2e-16 ``` --- ### Estimación de los parametros Se busca predecir los cambios en el número de arrestos a lo largo del tiempo. ```r mod1$coefficients ``` ``` ## (Intercept) observación detenido color_piel año ## 1.077702e+02 -1.160997e-05 6.867598e-01 -4.016072e-01 -5.115508e-02 ## edad sexo empleado ciudadano capturas ## 1.757521e-02 5.047902e-01 -6.089160e-01 1.394233e-01 -2.591278e+00 ``` Se podría identificar patrones temporales, de aumentos o disminuciones en la actividad delictiva a lo largo de este año. --- ### Modelos de clasificación ### Ajustar el modelo LDA con variables codificadas ```r #modelo_lda <- lda(detenido ~ ., data = datos) ``` --- ### Hacer predicciones y evaluar el rendimiento del modelo ```r #predicciones <- predict(modelo_lda, newdata = datos) #clases_predichas <- predicciones$class #tabla_confusion <- table(clases_predichas, datos$detenido) #accuracy <- sum(diag(tabla_confusion)) / sum(tabla_confusion) ``` --- ### Conclusión