Shooting Incidents Occurred in NYC from 2006 to 2022
Doris Chen
2023-07-25
Introduction
Shooting incidents have caused harm to many American families and attracted widespread attention in society. We looked into the data from NYPD, trying to discover patterns in the occurrence time, locations and victims of the incidents.
The data lists a breakdown of every shooting incident that occurred in New York City going back to 2006 through the end of 2022. More details please check the Data Source.
Load packages
library(tidyverse)
library(lubridate)
library(lessR)
library(caret)Import Data
url <- "https://data.cityofnewyork.us/api/views/833y-fsy8/rows.csv?accessType=DOWNLOAD"
NYPD_shooting <- read_csv(url, show_col_types = FALSE)We take a Look at the data to get some general ideas.
str(NYPD_shooting)The result is very long, so I set results='hide' to
avoid a long list in the report.
There are 27,312 observations of 21 variables. Quite a few of them are about locations or coordinates of the incidents which we’re not going to analysis this time. Also there are many NA’s in some variables, and the data types need to be modified.
Data Cleaning and Transforming
We select variables which we are interested in and clean the data.
NYPD_S <-NYPD_shooting %>%
select(INCIDENT_KEY, OCCUR_DATE, OCCUR_TIME, BORO, PRECINCT, STATISTICAL_MURDER_FLAG,
PERP_AGE_GROUP, PERP_SEX, PERP_RACE, VIC_AGE_GROUP, VIC_SEX, VIC_RACE) %>%
mutate(INCIDENT_KEY = as.factor(INCIDENT_KEY), OCCUR_DATE = mdy(OCCUR_DATE),
BORO = as.factor(BORO), PRECINCT = as.factor(PRECINCT),
STATISTICAL_MURDER_FLAG = as.factor(STATISTICAL_MURDER_FLAG),
PERP_AGE_GROUP = as.factor(PERP_AGE_GROUP), PERP_SEX = as.factor(PERP_SEX),
PERP_RACE = as.factor(PERP_RACE), VIC_AGE_GROUP = as.factor(VIC_AGE_GROUP),
VIC_SEX = as.factor(VIC_SEX), VIC_RACE = as.factor(VIC_RACE))
summary(NYPD_S)## INCIDENT_KEY OCCUR_DATE OCCUR_TIME BORO
## 173354054: 18 Min. :2006-01-01 Length:27312 BRONX : 7937
## 23749375 : 12 1st Qu.:2009-07-18 Class1:hms BROOKLYN :10933
## 24717013 : 12 Median :2013-04-29 Class2:difftime MANHATTAN : 3572
## 33478089 : 12 Mean :2014-01-06 Mode :numeric QUEENS : 4094
## 33706902 : 12 3rd Qu.:2018-10-15 STATEN ISLAND: 776
## 35803777 : 12 Max. :2022-12-31
## (Other) :27234
## PRECINCT STATISTICAL_MURDER_FLAG PERP_AGE_GROUP PERP_SEX
## 75 : 1557 FALSE:22046 18-24 :6222 (null): 640
## 73 : 1452 TRUE : 5266 25-44 :5687 F : 424
## 67 : 1216 UNKNOWN:3148 M :15439
## 44 : 1020 <18 :1591 U : 1499
## 79 : 1012 (null) : 640 NA's : 9310
## 47 : 953 (Other): 680
## (Other):20102 NA's :9344
## PERP_RACE VIC_AGE_GROUP VIC_SEX
## BLACK :11432 <18 : 2839 F: 2615
## WHITE HISPANIC: 2341 1022 : 1 M:24686
## UNKNOWN : 1836 18-24 :10086 U: 11
## BLACK HISPANIC: 1314 25-44 :12281
## (null) : 640 45-64 : 1863
## (Other) : 439 65+ : 181
## NA's : 9310 UNKNOWN: 61
## VIC_RACE
## AMERICAN INDIAN/ALASKAN NATIVE: 10
## ASIAN / PACIFIC ISLANDER : 404
## BLACK :19439
## BLACK HISPANIC : 2646
## UNKNOWN : 66
## WHITE : 698
## WHITE HISPANIC : 4049As we can see from the summary, the data of victim is quite complete, while more than 50% of ‘unknown’ or NA’s regarding perpetrator. So we’ll put away perpetrator’s information for now, only focusing on time, location and victims this time.
NYPD_S <-NYPD_S %>%
select(-c(PERP_AGE_GROUP, PERP_SEX, PERP_RACE)) %>%
mutate(YEAR = year(OCCUR_DATE), MONTH = month(OCCUR_DATE), HOUR = hour(OCCUR_TIME))According to the Data Footnotes, ‘Each INCIDENT_KEY represents a victim but similar duplicate keys are counted as one incident.’ So we decided to create a new table to analysis the pattern of incidents.
incidents <- NYPD_S %>%
distinct(INCIDENT_KEY, .keep_all = TRUE) %>%
select(INCIDENT_KEY, YEAR, MONTH, HOUR, BORO)Now we check if there is NA in any column of the two tables.
colSums(is.na(NYPD_S))## INCIDENT_KEY OCCUR_DATE OCCUR_TIME
## 0 0 0
## BORO PRECINCT STATISTICAL_MURDER_FLAG
## 0 0 0
## VIC_AGE_GROUP VIC_SEX VIC_RACE
## 0 0 0
## YEAR MONTH HOUR
## 0 0 0colSums(is.na(incidents))## INCIDENT_KEY YEAR MONTH HOUR BORO
## 0 0 0 0 0There are no NA’s in the two tables.
Data Visualization
We’ll visualize the data to answer some questions.
Question 1: what is the trend of shooting incidents happened in New York from 2006 to 2022?
incidents %>%
ggplot(aes(x = factor(YEAR))) +
geom_bar(fill = 'brown') +
labs(title = "Shooting Incidents in New York", subtitle = "From 2006 to 2022",
x = "Year", y = "Incidents") +
geom_text(stat = 'count', aes(label = ..count..), vjust = 1.5, col = 'white', size = 3) +
theme_classic()
As the plot demonstrated, the number of incidents was declining from 2006 to 2019, especially during 2014 to 2019, but shooting up again by nearly 50% during pandemic, reaching to a high point(1562) in 2021.
So it raised another question:
Question 2: which borough did the shooting incidents happen the most?
summary(incidents$BORO)## BRONX BROOKLYN MANHATTAN QUEENS STATEN ISLAND
## 6019 8806 2747 3229 619The shooting happened the most in Brooklyn, 8806 incidents in total over the last 17 years.
Here is the trend of shooting incidents happened in different boroughs from 2006 to 2022.
incidents %>%
ggplot(aes(x = factor(YEAR))) +
facet_wrap(~ BORO) +
geom_bar(aes(fill = BORO)) +
labs(title = "Shooting Incidents in Boroughs of New York", subtitle = "From 2006 to 2022",
x = "Year", y = "Incidents") +
geom_text(stat = 'count', aes(label = ..count..), vjust = -0.5, size = 2.5) +
theme_classic()+
theme(axis.text.x = element_text(angle = 90), legend.position = "bottom",
legend.title = element_blank())
Now we’ll discover if there is a pattern of time when the incidents happened.
Question 3: What hours did the incidents happen the most during a day?
incidents %>%
ggplot(aes(x = factor(HOUR))) +
geom_bar(fill = 'lightgrey') +
labs(title = "Shooting Incidents Occurence Time", x = "Hour", y = "Incidents") +
geom_text(stat = 'count', aes(label = ..count..), vjust = -0.5, size = 3) +
theme_classic()
The plot shows a clear pattern that the incidents happened the most at late night and early morning, especially during 10pm to 2am.
Question 4: What months did the incidents happen the most during a year?
incidents %>%
ggplot(aes(x = factor(MONTH))) +
geom_bar(fill = 'lightgrey') +
labs(title = "Shooting Incidents Occuring Months", x = "Month", y = "Incidents") +
geom_text(stat = 'count', aes(label = ..count..), vjust = -0.5, size = 3) +
theme_classic()
The incidents happened more during summer. Given that more incidents happened at night, especially 10pm to 2am, probably because more people hanging out at summer nights.
Now we’ll check about the information of victims.
Question 5: What are the genders, age groups and races of the victims?
table(NYPD_S$VIC_SEX)##
## F M U
## 2615 24686 11Over 90% of the victims were male.
table(NYPD_S$VIC_AGE_GROUP)##
## <18 1022 18-24 25-44 45-64 65+ UNKNOWN
## 2839 1 10086 12281 1863 181 61There are 61 “UNKNOWN” in victim age groups, since it’s less than 0.2%, we decide to ignore it. Also, we will change the one with “1022” to “UNKNOWN”.
NYPD_S$VIC_AGE_GROUP <- replace(NYPD_S$VIC_AGE_GROUP, NYPD_S$VIC_AGE_GROUP == 1022, 'UNKNOWN')
Vic_Age <- NYPD_S %>%
select(VIC_AGE_GROUP) %>%
filter(VIC_AGE_GROUP != 'UNKNOWN')
# The level of "1022" and "UNKNOWN" still exist, so we use "droplevels" here to remove the unused level.
Vic_Age$VIC_AGE_GROUP <- droplevels(Vic_Age$VIC_AGE_GROUP)## Using "lessR" package
PieChart(VIC_AGE_GROUP, hole = 0, values = "%", data = Vic_Age,
main = "Age Groups of Victims", labels_cex = 0.8, quiet = TRUE)
82% of victims were aging from 18 to 44, including 45% from 25 to 44, and 37% from 18 to 24.
Vic_Race <- NYPD_S %>%
select(VIC_RACE) %>%
filter(VIC_RACE != 'UNKNOWN')
Vic_Race$VIC_RACE <- droplevels(Vic_Race$VIC_RACE)
PieChart(VIC_RACE, hole = 0, values = "%", data = Vic_Race,
main = "Races of Victims", labels_cex = 0.8, quiet = TRUE)
71% of the victims were black, 25% were Hispanic(including 15% White Hispanic and 10% Black Hispanic).
Data Model
There is a variable shows if the incident was murder or not.
table(NYPD_S$STATISTICAL_MURDER_FLAG)##
## FALSE TRUE
## 22046 526619.28% of the incidents were murder. We’ll try to create a model using the variables of time(hour), location(precinct) and victims(sex, age, race) to predict if it is a murder or not.
NYPD <- NYPD_S %>%
select(-c(INCIDENT_KEY, OCCUR_DATE, OCCUR_TIME, BORO, YEAR, MONTH))Data splitting
set.seed(1234)
inTrain <- createDataPartition(y = NYPD$STATISTICAL_MURDER_FLAG, p = 0.80, list = FALSE)
training <- NYPD[inTrain, ]
testing <- NYPD[-inTrain, ]Fit a model
mod <- train(STATISTICAL_MURDER_FLAG ~., data = training, method = 'glm',
trControl = trainControl(method = "cv", number = 3), family = "binomial")Prediction and Testing
pred <- predict(mod, newdata = testing)
confusionMatrix(pred, testing$STATISTICAL_MURDER_FLAG)## Confusion Matrix and Statistics
##
## Reference
## Prediction FALSE TRUE
## FALSE 4409 1051
## TRUE 0 2
##
## Accuracy : 0.8076
## 95% CI : (0.7969, 0.818)
## No Information Rate : 0.8072
## P-Value [Acc > NIR] : 0.4809
##
## Kappa : 0.0031
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 1.000000
## Specificity : 0.001899
## Pos Pred Value : 0.807509
## Neg Pred Value : 1.000000
## Prevalence : 0.807213
## Detection Rate : 0.807213
## Detection Prevalence : 0.999634
## Balanced Accuracy : 0.500950
##
## 'Positive' Class : FALSE
## The accuracy is 80.76%, but it actually only predicted 2 “True” murders while there were 1051. This suggests that there is no apparent pattern formed by the combination of time, location and victims in murder shooting incidents from the data.
Conclusion
After exploring the data, we have several findings as following:
- Overall Trend: The number of incidents in New York City was declining from 2006 to 2019, but shooting up again by nearly 50% during pandemic, reaching to a high point(1562) in 2021;
- Region and Time: The shootings occurred most frequently in Brooklyn, primarily during late night and early morning hours, and were more common in the summer;
- Victim: 90% of victims were male; 82% of victims were aging from 18 to 44; 71% of the victims were black, 25% were Hispanic(including 15% White Hispanic and 10% Black Hispanic).
Also, we tried to build a model using time, location and victims to predict the type of incidents, but it didn’t work very well. This may suggest that there is no apparent pattern of time, precinct and victims in murder shooting incidents from the data.
Bias Identification
Two aspects of bias may exist in the above analysis:
1. Data: Over 50% of missing data regarding perpetrators’ information.
It could be random, or could exist certain bias during data entry.
2. Personal: When talking about shooting or criminal incidents, I
realized that I may have a little bias regarding of the perpetrators and
victims, like people at some education levels or grew up from certain
environment might be more likely to commit crime, or due to the social
bias, individuals of some races may be more vulnerable to becoming
victims.
Due to the missing data, I didn’t look into the perpetrators’ data this time but the victims. I aware of my bias, so I didn’t put too much weight of analyzing the victims’ races. Instead, I was trying to find a pattern of when the incidents happened and where it happened the most, also drawing a general picture of the genders, age groups and races of victims.
Appendix
sessionInfo()## R version 4.2.1 (2022-06-23)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Big Sur ... 10.16
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] caret_6.0-93 lattice_0.20-45 lessR_4.2.9 lubridate_1.8.0
## [5] forcats_0.5.2 stringr_1.5.0 dplyr_1.0.10 purrr_1.0.1
## [9] readr_2.1.3 tidyr_1.3.0 tibble_3.1.8 ggplot2_3.4.1
## [13] tidyverse_1.3.2
##
## loaded via a namespace (and not attached):
## [1] googledrive_2.0.0 colorspace_2.0-3 deldir_1.0-6
## [4] ellipsis_0.3.2 class_7.3-20 fs_1.5.2
## [7] proxy_0.4-27 rstudioapi_0.14 farver_2.1.1
## [10] listenv_0.9.0 bit64_4.0.5 prodlim_2019.11.13
## [13] fansi_1.0.4 xml2_1.3.3 codetools_0.2-18
## [16] splines_4.2.1 leaps_3.1 cachem_1.0.6
## [19] robustbase_0.99-0 knitr_1.40 jsonlite_1.8.4
## [22] pROC_1.18.0 broom_1.0.1 dbplyr_2.2.1
## [25] png_0.1-8 compiler_4.2.1 httr_1.4.4
## [28] backports_1.4.1 assertthat_0.2.1 Matrix_1.5-3
## [31] fastmap_1.1.0 gargle_1.2.1 cli_3.6.0
## [34] htmltools_0.5.4 tools_4.2.1 gtable_0.3.1
## [37] glue_1.6.2 reshape2_1.4.4 Rcpp_1.0.9
## [40] cellranger_1.1.0 jquerylib_0.1.4 vctrs_0.5.2
## [43] nlme_3.1-157 iterators_1.0.14 timeDate_4022.108
## [46] xfun_0.37 gower_1.0.1 globals_0.16.2
## [49] openxlsx_4.2.5.2 rvest_1.0.3 lifecycle_1.0.3
## [52] googlesheets4_1.0.1 future_1.31.0 DEoptimR_1.1-0
## [55] MASS_7.3-57 scales_1.2.1 ipred_0.9-13
## [58] vroom_1.6.1 hms_1.1.2 parallel_4.2.1
## [61] RColorBrewer_1.1-3 curl_4.3.3 sass_0.4.2
## [64] rpart_4.1.16 latticeExtra_0.6-30 stringi_1.7.8
## [67] highr_0.9 foreach_1.5.2 e1071_1.7-13
## [70] hardhat_1.2.0 zip_2.2.2 lava_1.7.1
## [73] rlang_1.0.6 pkgconfig_2.0.3 evaluate_0.17
## [76] labeling_0.4.2 recipes_1.0.4 bit_4.0.5
## [79] tidyselect_1.2.0 parallelly_1.34.0 plyr_1.8.8
## [82] magrittr_2.0.3 R6_2.5.1 generics_0.1.3
## [85] DBI_1.1.3 pillar_1.8.1 haven_2.5.1
## [88] withr_2.5.0 survival_3.3-1 nnet_7.3-17
## [91] future.apply_1.10.0 modelr_0.1.9 crayon_1.5.2
## [94] interp_1.1-3 utf8_1.2.3 ellipse_0.4.3
## [97] tzdb_0.3.0 rmarkdown_2.20 jpeg_0.1-10
## [100] grid_4.2.1 readxl_1.4.1 data.table_1.14.2
## [103] ModelMetrics_1.2.2.2 reprex_2.0.2 digest_0.6.29
## [106] stats4_4.2.1 munsell_0.5.0 bslib_0.4.0