Marijuana Arrests in Toronto: Racial Disparities
Fernando José Álvarez Petro & Diego Andrés Moreno López
Introducción - Busqueda de base de datos
La base de datos “Marijuana Arrests in Toronto: Racial Disparities” se enfoca en el tratamiento policial de individuos arrestados en Toronto por posesión simple de pequeñas cantidades de marihuana. Los datos fueron recopilados como parte de un estudio que buscaba examinar las disparidades raciales en los arrestos relacionados con la marihuana en esa ciudad.
La base de datos consta de un data frame que contiene 5226 observaciones y 8 variables diferentes. A continuación, se proporciona una descripción detallada de cada variable:
released: Esta variable indica si la persona arrestada fue liberada con una citación. Es un factor categórico con dos niveles: “No” y “Yes”.
colour: Representa la raza del individuo arrestado. Es un factor categórico con dos niveles: “Black” (negro) y “White” (blanco).
year: Indica el año en que ocurrió el arresto. Es una variable numérica que abarca el período de 1997 a 2002.
age: Muestra la edad de la persona arrestada en años. Es una variable numérica continua.
sex: Representa el género de la persona arrestada. Es un factor categórico con dos niveles: “Female” (mujer) y “Male” (hombre).
employed: Indica si la persona arrestada está empleada. Es un factor categórico con dos niveles: “No” y “Yes”.
citizen: Muestra si la persona arrestada es ciudadana. Es un factor categórico con dos niveles: “No” y “Yes”.
checks: Representa el número de bases de datos policiales en las que aparece el nombre del arrestado. Estas bases de datos contienen información sobre arrestos anteriores, condenas previas, estado de libertad condicional, entre otros aspectos. Es una variable numérica continua.
El análisis de esta base de datos puede ayudar a comprender mejor las inequidades en el sistema de justicia penal, particularmente en relación con la posesión de marihuana, y puede proporcionar información valiosa para discusiones sobre políticas de aplicación de la ley y reformas relacionadas con la justicia racial.
A continuación se anexa el link de descarga https://www.kaggle.com/datasets/utkarshx27/arrests-for-marijuana-possession?resource=download
Tratamiento a los datos
Paquetes
Para dar inicio a la investigacion de la base de datos se requiere hacer uso de los siguientes paquetes:
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0 ✔ purrr 1.0.1
## ✔ tibble 3.1.8 ✔ dplyr 1.1.0
## ✔ tidyr 1.3.0 ✔ stringr 1.5.0
## ✔ readr 2.1.4 ✔ forcats 1.0.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 4.2.3##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutlibrary(leaps)
library(MASS) ##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:plotly':
##
## select
##
## The following object is masked from 'package:dplyr':
##
## selectEl paquete tidyverse es una colección de paquetes de R diseñados para facilitar la manipulación, visualización y análisis de datos. Incluye paquetes populares como ggplot2 para visualización, dplyr para manipulación de datos, tidyr para limpieza y transformación de datos, readr para importar datos y otros paquetes útiles.
Por otro lado, el paquete plotly es una interfaz para crear gráficos interactivos, como gráficos de dispersión, gráficos de barras, gráficos de líneas y muchos más. Plotly es especialmente útil cuando se desea crear visualizaciones interactivas para explorar y presentar datos de manera dinámica.
Por ultimo, el paquete leaps proporciona funciones para realizar selección de variables y ajuste de modelos utilizando el método de regresión por pasos. Este paquete es útil cuando se desea encontrar el conjunto óptimo de variables predictoras en un modelo de regresión. Permite realizar búsquedas exhaustivas o basadas en criterios estadísticos para encontrar el mejor subconjunto de variables para predecir una variable de interés.
Exportar archivo
Una vez descargada la base de datos se procede a cargarla en la
consola de la interfaz del software usado para el analisis estadistico,
en este caso Rstudio, para ello se emplean los
siguientes codigos
#file.choose()
datos <- read.csv("C:\\Users\\ferna\\OneDrive - UPB\\Documents\\Upb\\Semestre 9\\Ciencia de datos\\FINAL PROJECT\\Arrests.csv")La primera función se utiliza para seleccionar un archivo interactivamente a través de una ventana emergente del sistema operativo. La segunda buscar y carga la base de datos desde la ruta del archivo alojado en el disco local de la computadora.
Acercamiento a la base de datos
Lo primero que se hace al tener una base de datos es conocer la estructura que lo conforma, es decir, la cantidad de observaciones, variables, la natrualeza de las variables, etc, por eso se hace uso de la siguiente función:
head(datos)Para mayor practicidad y entendimiento por parte de los
investigadores se renombran las variables presentadas al inicar este
documento, cabe resaltar que se uso la función
rename del paquete
dplyr.
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
Dada la naturaleza de la base de datos, surgen nuevas observaciones por la combinación o tranformación de datos de una o más variables, como se presentan a continuación:
- El jefe del ayuntamiento de Toronto quiere conocer en que edades se encuentran las personas que son capturadas por el porte de drogas y determinar a quienes deben estar enfocados los nuevos planes sociales, para ello se categorizan dichos individuos por su ciclo de vida.
datos <- datos %>% mutate(
ciclo_vida = ifelse(edad <= 11, "Niñez",
ifelse(edad <= 19, "Adolecencia",
ifelse(edad <= 24, "Juventud",
ifelse(edad <= 59, "Adultez",
ifelse(edad >= 60, "Vejez", "Error")))))
)- El jefe del ayuntamiento de Toronto ha lanzado un programa denominado “Ayuda a Cuidadanos de Toronto” ACT para cuidadanos desempleados que tengan una conducta reiterativa con la ley, de igual forma el gobierno de Canada ha creado un programa para aquellas personas que tienen una conducta reiterativa con la ley en su pais y estan desempleado denominado “Ayuda Canadiense Basica Cuidadana” (ACBC), por ultimo el jefe de la fiscalia de Canada planea hacer un programa de vigilancia a quellos que no cumplan con los anteriores criterios. Se busca clasificar a dichos individuos.
datos <- datos %>% mutate(
Apoyo_Gobierno = ifelse(n_arrestos >= 3 & empleado == "No" & ciudadano == "Yes", "ACT",
ifelse(n_arrestos >= 3 & empleado == "No" & ciudadano == "No", "ACBC", "Vigilar"))
)- El jefe del ayuntamiento y el jefe de la policia de Toronto sospechan que hay policias que realizan mal sus procedimiento y/o estan no estan actuando conforme a lo establecido en la ley.
datos <- datos %>% mutate(
capturas = ifelse(n_arrestos >= 3 & detenido == "No", "Investigar", "No investigar")
)La estructura para definir las nuevas variables dentro de la base de
datos, es por medio de la función mutate del
paquete dplyr teniendo ciertas consideraciones
EDA
Se realiza un analisis exploratorio a los datos con el fin de explorar el comportamiento individual y en conjunto de algunas varible.
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)Del grafico anterior “Personas detenidas vs Raza” se evidencia una alta tendencia de personas de color blanco deternidas por el porte de droga en Toronto.
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)Del grafico anterior “Edad de las personas que portaban droga” las personas que se encuentran entre el rango de edad de 10 a menos de 30 años son las que con mas frecuencia son detenidas por el porte de drogas en Toronto, mientras que el resto presenta menos frecuencia.
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)Del grafico anterior “Relación entre el número de arrestos y las personas detenidas” muy pocas personas son dejadas en libertad luego de ser reincidente en más de 3 ocasiones.
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)#cor.test(año, edad)según la prueba de hipotesis NO hay correlación entre las variables.
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)Del grafico anterior “Historial arrestos vs ultima detención” es evidente que a mayor número de arrestos en el historial de una persona, en su proxima detención no será detenido
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.Del grafico anterior “Relación del número de arrestos vs edad de la persona” existe una mayor tendencia de que personas de 10 a menos de 30 años sea su primer arresto, por lo que no presentan historial delictivo.
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)#cor.test(edad, n_arrestos)según la prueba de hipotesis hay correlación entre las variables, es una correlación directa baja
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)#cor.test(año, n_arrestos)Según la prueba de hipotesis hay correlación entre las variables, es una correlación inversa baja.
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)#cor.test(año, edad)Según la prueba de hipotesis NO hay correlación entre las variables
Regresión
Un modelo de regresión se utiliza cuando se desea predecir o estimar un valor numérico continuo. En este tipo de modelo, la variable de salida (variable dependiente) es una variable continua, y el objetivo es encontrar una relación funcional entre las variables predictoras (variables independientes) y la variable de salida. El modelo de regresión busca encontrar la mejor línea o curva de ajuste que minimice la diferencia entre los valores predichos y los valores reales.
Transformación de variables
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(.)))Se usan los siguientes metodos para la selección de variables:
Metodo de selección de variable
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.2050672 0.2900531 0.2995339 0.3074884 0.3133149 0.3194542 0.3235950
## [8] 0.3245519 0.3252846print(mejor_i)## [1] 9mod_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
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 FALSE
## 3 TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE
## 4 TRUE FALSE FALSE TRUE FALSE FALSE TRUE FALSE
## 5 TRUE FALSE TRUE TRUE FALSE FALSE TRUE FALSE
## 6 TRUE FALSE TRUE TRUE FALSE TRUE TRUE FALSE
## 7 TRUE FALSE TRUE TRUE FALSE TRUE TRUE TRUE
## 8 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE
## ciudadano ciclo_vidaAdultez ciclo_vidaJuventud ciclo_vidaVejez
## 1 FALSE FALSE FALSE FALSE
## 2 FALSE FALSE FALSE FALSE
## 3 FALSE FALSE FALSE FALSE
## 4 FALSE FALSE FALSE FALSE
## 5 FALSE FALSE FALSE FALSE
## 6 FALSE FALSE FALSE FALSE
## 7 FALSE FALSE FALSE FALSE
## 8 FALSE FALSE FALSE FALSE
## Apoyo_GobiernoACT Apoyo_GobiernoVigilar capturas
## 1 FALSE TRUE FALSE
## 2 FALSE TRUE TRUE
## 3 FALSE TRUE TRUE
## 4 FALSE TRUE TRUE
## 5 FALSE TRUE TRUE
## 6 FALSE TRUE TRUE
## 7 FALSE TRUE TRUE
## 8 FALSE TRUE TRUEPoint <- tb1 %>% filter(r2adj1 == max(tb1$r2adj1))Método back
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 FALSE
## 3 TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE
## 4 TRUE FALSE FALSE TRUE FALSE FALSE TRUE FALSE
## 5 TRUE FALSE FALSE TRUE FALSE TRUE TRUE FALSE
## 6 TRUE FALSE FALSE TRUE FALSE TRUE TRUE TRUE
## 7 TRUE FALSE TRUE TRUE FALSE TRUE TRUE TRUE
## 8 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE
## ciudadano ciclo_vidaAdultez ciclo_vidaJuventud ciclo_vidaVejez
## 1 FALSE FALSE FALSE FALSE
## 2 FALSE FALSE FALSE FALSE
## 3 FALSE FALSE FALSE FALSE
## 4 FALSE FALSE FALSE FALSE
## 5 FALSE FALSE FALSE FALSE
## 6 FALSE FALSE FALSE FALSE
## 7 FALSE FALSE FALSE FALSE
## 8 FALSE FALSE FALSE FALSE
## Apoyo_GobiernoACT Apoyo_GobiernoVigilar capturas
## 1 FALSE TRUE FALSE
## 2 FALSE TRUE TRUE
## 3 FALSE TRUE TRUE
## 4 FALSE TRUE TRUE
## 5 FALSE TRUE TRUE
## 6 FALSE TRUE TRUE
## 7 FALSE TRUE TRUE
## 8 FALSE TRUE TRUEPoint <- tb4 %>% filter(r2adj4 == max(tb4$r2adj4))Estimación del mejor modelo
Se proponen los siguientes modelos de regresión y se evaluan bajo la metrica de r2ajustado para tomar el mejor
mod1 <- lm(formula = n_arrestos ~ ., data = datos)
summary(mod1)##
## Call:
## lm(formula = n_arrestos ~ ., data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1347 -1.1643 -0.2124 0.8459 4.4829
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.576e+01 2.613e+01 3.665 0.000250 ***
## observación -1.468e-05 1.159e-05 -1.266 0.205482
## detenido 3.952e-01 6.998e-02 5.647 1.72e-08 ***
## color_piel -3.735e-01 4.234e-02 -8.821 < 2e-16 ***
## año -4.557e-02 1.308e-02 -3.484 0.000499 ***
## edad 9.372e-03 4.188e-03 2.238 0.025272 *
## sexo 4.794e-01 6.324e-02 7.582 4.01e-14 ***
## empleado 3.551e-01 6.043e-02 5.876 4.47e-09 ***
## ciudadano 8.984e-02 5.665e-02 1.586 0.112859
## ciclo_vidaAdultez 1.549e-01 8.018e-02 1.932 0.053366 .
## ciclo_vidaJuventud 7.691e-02 4.712e-02 1.632 0.102662
## ciclo_vidaVejez -1.608e-01 4.447e-01 -0.362 0.717732
## Apoyo_GobiernoACT 2.599e-01 1.412e-01 1.840 0.065759 .
## Apoyo_GobiernoVigilar -1.675e+00 1.408e-01 -11.898 < 2e-16 ***
## capturas -1.886e+00 9.169e-02 -20.572 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.264 on 5211 degrees of freedom
## Multiple R-squared: 0.3277, Adjusted R-squared: 0.3259
## F-statistic: 181.4 on 14 and 5211 DF, p-value: < 2.2e-16El modelo mod1 es aquel que presenta mejor resultado en la metrica, a continuación se estiman sus parametros
Estimación de los parametros
Se busca predecir los cambios en el número de arrestos a lo largo del tiempo.
mod1$coefficients## (Intercept) observación detenido
## 9.576218e+01 -1.468187e-05 3.952298e-01
## color_piel año edad
## -3.734913e-01 -4.557290e-02 9.372209e-03
## sexo empleado ciudadano
## 4.794383e-01 3.550658e-01 8.983780e-02
## ciclo_vidaAdultez ciclo_vidaJuventud ciclo_vidaVejez
## 1.549468e-01 7.691441e-02 -1.607614e-01
## Apoyo_GobiernoACT Apoyo_GobiernoVigilar capturas
## 2.598609e-01 -1.675462e+00 -1.886301e+00Se 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
modelo_lda <- lda(detenido ~ ., data = datos)Hacer predicciones y evaluar el rendimiento del modelo
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)