library(leaflet)
library(tidyverse)
library(lubridate)
library(broom)
library(plotly)
library(DT)
- The following two maps show mass shootings in the United States. The first and second map show the same information with the difference being the second map has reduced sized dots.
shootings <- read_csv("https://docs.google.com/spreadsheets/d/1b9o6uDO18sLxBqPwl_Gh9bnhW-ev_dABH83M5Vb5L8o/export?format=csv", na = "-")
shootings %>%
leaflet() %>%
addTiles() %>%
setView(lat = 39.828175, lng = -98.5795, zoom = 3) %>%
addCircleMarkers(stroke = F, fillOpacity = .6, radius = ~fatalities)
Assuming "longitude" and "latitude" are longitude and latitude, respectively
shootings %>%
leaflet() %>%
addTiles() %>%
setView(lat = 39.828175, lng = -98.5795, zoom = 3) %>%
addCircleMarkers(stroke = F, fillOpacity = .6, radius = ~log(total_victims))
Assuming "longitude" and "latitude" are longitude and latitude, respectively
The maps portray information on mass shootings in the continental USA. The bigger the dot is on the map, the more victims there were in that mass shooting. As one can see from the map, mass shootings with the most victims seem to have occurred in places like Nevada, California, and Florida. The coordinates used for the two maps shown above are the center of the continental USA.
- The following is additional information on the mass shootings that have occurred in the USA. A. The following shows the median number of victims as well as the median number of fatalities.
shootings %>%
drop_na(total_victims) %>%
summarize(total_victims = median(total_victims))
shootings %>%
drop_na(fatalities) %>%
summarize(fatalities = median(fatalities))
The average number of victims for a mass shooting in the USA is 10 and the average number of fatalities is 6. B. The following is a histogram of the number of shootings per year.
shootings %>%
plot_ly(x = ~year) %>%
add_histogram(nbinsx = 40)
NA
According to the above histogram, the number of mass shootings per year has increased from 1985 to 2022. In the 40 years that this data covers, the most mass shootings in one year occurred in 2018-2019 with 22 mass shootings. The least amount of mass shootings in one year occured in 1982-1983 and 2002-2003 with only one mass shooting in those years. C. The following is a heatmap of the gender and race of the shooter.
shootings %>%
drop_na(race) %>%
mutate(race = as_factor(race)) %>%
mutate(race = fct_collapse(race, White = c("White", "white"), Black = c("black", "Black"), Other = c("unclear", "other"))) %>%
mutate(gender = fct_collapse(gender, Male = c("Male", "M"), Female = c("F", "Female"))) %>%
plot_ly(x = ~race, y = ~gender) %>%
add_histogram2dcontour()
Warning: Problem while computing `race = fct_collapse(...)`.
ℹ Unknown levels in `f`: other
The heatmap represents the different races and genders of the individuals who carried out mass shootings in the US. As the heatmap shows, the most common race and gender who committed a mass shooting was a white male. The following is a heatmap of gender and age of the shooter.
shootings %>%
drop_na(age_of_shooter) %>%
drop_na(gender) %>%
mutate(gender = fct_collapse(gender, Male = c("Male", "M"), Female = c("F", "Female"))) %>%
plot_ly(x = ~gender, y = ~age_of_shooter) %>%
add_histogram2dcontour()
The above graphic is a heatmap of the age and gender of individuals who have committed a mass shooting in the US. The most common age and gender is a male around 24.5 years old. From the two heatmaps, it is safe to say from this data that the most common mass shooter was a white male in his 20’s. D. The following is a scatterplot of the number injured by the number of fatalities.
shootings %>%
plot_ly(x = ~fatalities, y = ~injured) %>%
add_markers()
The scatterplot shows the number of fatalities by the number of people injured in the mass shootings. If one puts their curser over a specific marker on the graph, the numbers will show. For example, the marker closer to 50 on the x-axis will show (49,53) meaning that there were 49 fatalities and 53 people were injured.
- The following is a regression analysis testing the hypothesis that the number of mass shootings have increased over the years. A graph is also included.
shootings_per_year <- shootings %>%
filter(fatalities > 3) %>%
count(year)
shootings_per_year
shootings_per_year_model <- lm(n ~ year, data = shootings_per_year)
tidy(shootings_per_year_model)
glance(shootings_per_year_model)
NA
shootings_per_year %>%
plot_ly(x = ~year,
y = ~n, hoverinfo = "text", text = ~paste("Number of shootings per year: ", round(shootings_per_year, 1), "<br>", "Year: ", year)) %>%
add_markers(showlegend = F) %>%
add_lines(y = ~fitted(shootings_per_year_model)) %>%
layout(title = "Number of shootings per year", xaxis = list(title = "Year"), yaxis = list(title = "Number of shootings"))
NA
In this regression analysis, the hypothesis that the number of mass shootings per year have increased was tested. The p-value of 0.0001 is statistically significant because it is below 0.04. Having a statistically significant p-value indicates that the hypothesis is true. Furthermore, the graph shows that the number of mass shootings per year has increased. This is seen with the positive slope of the orange line.
LS0tCnRpdGxlOiAiRG90IE1hcHMiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KYGBge3J9CmxpYnJhcnkobGVhZmxldCkKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkobHVicmlkYXRlKQpsaWJyYXJ5KGJyb29tKQpsaWJyYXJ5KHBsb3RseSkKbGlicmFyeShEVCkKCmBgYAoKMS4gVGhlIGZvbGxvd2luZyB0d28gbWFwcyBzaG93IG1hc3Mgc2hvb3RpbmdzIGluIHRoZSBVbml0ZWQgU3RhdGVzLiBUaGUgZmlyc3QgYW5kIHNlY29uZCBtYXAgc2hvdyB0aGUgc2FtZSBpbmZvcm1hdGlvbiB3aXRoIHRoZSBkaWZmZXJlbmNlIGJlaW5nIHRoZSBzZWNvbmQgbWFwIGhhcyByZWR1Y2VkIHNpemVkIGRvdHMuIApgYGB7cn0Kc2hvb3RpbmdzIDwtIHJlYWRfY3N2KCJodHRwczovL2RvY3MuZ29vZ2xlLmNvbS9zcHJlYWRzaGVldHMvZC8xYjlvNnVETzE4c0x4QnFQd2xfR2g5Ym5oVy1ldl9kQUJIODNNNVZiNUw4by9leHBvcnQ/Zm9ybWF0PWNzdiIsIG5hID0gIi0iKQpgYGAKYGBge3J9CnNob290aW5ncyAlPiUKICBsZWFmbGV0KCkgJT4lIAogIGFkZFRpbGVzKCkgJT4lCiAgc2V0VmlldyhsYXQgPSAzOS44MjgxNzUsIGxuZyA9IC05OC41Nzk1LCB6b29tID0gMykgJT4lCiAgYWRkQ2lyY2xlTWFya2VycyhzdHJva2UgPSBGLCBmaWxsT3BhY2l0eSA9IC42LCByYWRpdXMgPSB+ZmF0YWxpdGllcykKYGBgCmBgYHtyfQpzaG9vdGluZ3MgJT4lCiAgbGVhZmxldCgpICU+JSAKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobGF0ID0gMzkuODI4MTc1LCBsbmcgPSAtOTguNTc5NSwgem9vbSA9IDMpICU+JQogIGFkZENpcmNsZU1hcmtlcnMoc3Ryb2tlID0gRiwgZmlsbE9wYWNpdHkgPSAuNiwgcmFkaXVzID0gfmxvZyh0b3RhbF92aWN0aW1zKSkKYGBgClRoZSBtYXBzIHBvcnRyYXkgaW5mb3JtYXRpb24gb24gbWFzcyBzaG9vdGluZ3MgaW4gdGhlIGNvbnRpbmVudGFsIFVTQS4gVGhlIGJpZ2dlciB0aGUgZG90IGlzIG9uIHRoZSBtYXAsIHRoZSBtb3JlIHZpY3RpbXMgdGhlcmUgd2VyZSBpbiB0aGF0IG1hc3Mgc2hvb3RpbmcuIEFzIG9uZSBjYW4gc2VlIGZyb20gdGhlIG1hcCwgbWFzcyBzaG9vdGluZ3Mgd2l0aCB0aGUgbW9zdCB2aWN0aW1zIHNlZW0gdG8gaGF2ZSBvY2N1cnJlZCBpbiBwbGFjZXMgbGlrZSBOZXZhZGEsIENhbGlmb3JuaWEsIGFuZCBGbG9yaWRhLiBUaGUgY29vcmRpbmF0ZXMgdXNlZCBmb3IgdGhlIHR3byBtYXBzIHNob3duIGFib3ZlIGFyZSB0aGUgY2VudGVyIG9mIHRoZSBjb250aW5lbnRhbCBVU0EuIAoKMi4gVGhlIGZvbGxvd2luZyBpcyBhZGRpdGlvbmFsIGluZm9ybWF0aW9uIG9uIHRoZSBtYXNzIHNob290aW5ncyB0aGF0IGhhdmUgb2NjdXJyZWQgaW4gdGhlIFVTQS4gCkEuIFRoZSBmb2xsb3dpbmcgc2hvd3MgdGhlIG1lZGlhbiBudW1iZXIgb2YgdmljdGltcyBhcyB3ZWxsIGFzIHRoZSBtZWRpYW4gbnVtYmVyIG9mIGZhdGFsaXRpZXMuCmBgYHtyfQpzaG9vdGluZ3MgJT4lIAogIGRyb3BfbmEodG90YWxfdmljdGltcykgJT4lIAogIHN1bW1hcml6ZSh0b3RhbF92aWN0aW1zID0gbWVkaWFuKHRvdGFsX3ZpY3RpbXMpKQpgYGAKYGBge3J9CnNob290aW5ncyAlPiUgCiAgZHJvcF9uYShmYXRhbGl0aWVzKSAlPiUgCiAgc3VtbWFyaXplKGZhdGFsaXRpZXMgPSBtZWRpYW4oZmF0YWxpdGllcykpCmBgYApUaGUgYXZlcmFnZSBudW1iZXIgb2YgdmljdGltcyBmb3IgYSBtYXNzIHNob290aW5nIGluIHRoZSBVU0EgaXMgMTAgYW5kIHRoZSBhdmVyYWdlIG51bWJlciBvZiBmYXRhbGl0aWVzIGlzIDYuIApCLiBUaGUgZm9sbG93aW5nIGlzIGEgaGlzdG9ncmFtIG9mIHRoZSBudW1iZXIgb2Ygc2hvb3RpbmdzIHBlciB5ZWFyLiAKYGBge3J9CnNob290aW5ncyAlPiUgCiAgcGxvdF9seSh4ID0gfnllYXIpICU+JSAKICBhZGRfaGlzdG9ncmFtKG5iaW5zeCA9IDQwKQoKYGBgCkFjY29yZGluZyB0byB0aGUgYWJvdmUgaGlzdG9ncmFtLCB0aGUgbnVtYmVyIG9mIG1hc3Mgc2hvb3RpbmdzIHBlciB5ZWFyIGhhcyBpbmNyZWFzZWQgZnJvbSAxOTg1IHRvIDIwMjIuIEluIHRoZSA0MCB5ZWFycyB0aGF0IHRoaXMgZGF0YSBjb3ZlcnMsIHRoZSBtb3N0IG1hc3Mgc2hvb3RpbmdzIGluIG9uZSB5ZWFyIG9jY3VycmVkIGluIDIwMTgtMjAxOSB3aXRoIDIyIG1hc3Mgc2hvb3RpbmdzLiBUaGUgbGVhc3QgYW1vdW50IG9mIG1hc3Mgc2hvb3RpbmdzIGluIG9uZSB5ZWFyIG9jY3VyZWQgaW4gMTk4Mi0xOTgzIGFuZCAyMDAyLTIwMDMgd2l0aCBvbmx5IG9uZSBtYXNzIHNob290aW5nIGluIHRob3NlIHllYXJzLiAKQy4gVGhlIGZvbGxvd2luZyBpcyBhIGhlYXRtYXAgb2YgdGhlIGdlbmRlciBhbmQgcmFjZSBvZiB0aGUgc2hvb3Rlci4gCmBgYHtyfQpzaG9vdGluZ3MgJT4lCiAgZHJvcF9uYShyYWNlKSAlPiUKICBtdXRhdGUocmFjZSA9IGFzX2ZhY3RvcihyYWNlKSkgJT4lCiAgbXV0YXRlKHJhY2UgPSBmY3RfY29sbGFwc2UocmFjZSwgV2hpdGUgPSBjKCJXaGl0ZSIsICJ3aGl0ZSIpLCBCbGFjayA9IGMoImJsYWNrIiwgIkJsYWNrIiksIE90aGVyID0gYygidW5jbGVhciIsICJvdGhlciIpKSkgJT4lCiAgbXV0YXRlKGdlbmRlciA9IGZjdF9jb2xsYXBzZShnZW5kZXIsIE1hbGUgPSBjKCJNYWxlIiwgIk0iKSwgRmVtYWxlID0gYygiRiIsICJGZW1hbGUiKSkpICU+JQogIHBsb3RfbHkoeCA9IH5yYWNlLCB5ID0gfmdlbmRlcikgJT4lCiAgYWRkX2hpc3RvZ3JhbTJkY29udG91cigpCmBgYApUaGUgaGVhdG1hcCByZXByZXNlbnRzIHRoZSBkaWZmZXJlbnQgcmFjZXMgYW5kIGdlbmRlcnMgb2YgdGhlIGluZGl2aWR1YWxzIHdobyBjYXJyaWVkIG91dCBtYXNzIHNob290aW5ncyBpbiB0aGUgVVMuIEFzIHRoZSBoZWF0bWFwIHNob3dzLCB0aGUgbW9zdCBjb21tb24gcmFjZSBhbmQgZ2VuZGVyIHdobyBjb21taXR0ZWQgYSBtYXNzIHNob290aW5nIHdhcyBhIHdoaXRlIG1hbGUuIApUaGUgZm9sbG93aW5nIGlzIGEgaGVhdG1hcCBvZiBnZW5kZXIgYW5kIGFnZSBvZiB0aGUgc2hvb3Rlci4gCmBgYHtyfQpzaG9vdGluZ3MgJT4lCiAgZHJvcF9uYShhZ2Vfb2Zfc2hvb3RlcikgJT4lCiAgZHJvcF9uYShnZW5kZXIpICU+JQogIG11dGF0ZShnZW5kZXIgPSBmY3RfY29sbGFwc2UoZ2VuZGVyLCBNYWxlID0gYygiTWFsZSIsICJNIiksIEZlbWFsZSA9IGMoIkYiLCAiRmVtYWxlIikpKSAlPiUKICBwbG90X2x5KHggPSB+Z2VuZGVyLCB5ID0gfmFnZV9vZl9zaG9vdGVyKSAlPiUKICBhZGRfaGlzdG9ncmFtMmRjb250b3VyKCkKYGBgClRoZSBhYm92ZSBncmFwaGljIGlzIGEgaGVhdG1hcCBvZiB0aGUgYWdlIGFuZCBnZW5kZXIgb2YgaW5kaXZpZHVhbHMgd2hvIGhhdmUgY29tbWl0dGVkIGEgbWFzcyBzaG9vdGluZyBpbiB0aGUgVVMuIFRoZSBtb3N0IGNvbW1vbiBhZ2UgYW5kIGdlbmRlciBpcyBhIG1hbGUgYXJvdW5kIDI0LjUgeWVhcnMgb2xkLiBGcm9tIHRoZSB0d28gaGVhdG1hcHMsIGl0IGlzIHNhZmUgdG8gc2F5IGZyb20gdGhpcyBkYXRhIHRoYXQgdGhlIG1vc3QgY29tbW9uIG1hc3Mgc2hvb3RlciB3YXMgYSB3aGl0ZSBtYWxlIGluIGhpcyAyMCdzLiAKRC4gVGhlIGZvbGxvd2luZyBpcyBhIHNjYXR0ZXJwbG90IG9mIHRoZSBudW1iZXIgaW5qdXJlZCBieSB0aGUgbnVtYmVyIG9mIGZhdGFsaXRpZXMuIApgYGB7cn0Kc2hvb3RpbmdzICU+JQogIHBsb3RfbHkoeCA9IH5mYXRhbGl0aWVzLCB5ID0gfmluanVyZWQpICU+JQogIGFkZF9tYXJrZXJzKCkKYGBgClRoZSBzY2F0dGVycGxvdCBzaG93cyB0aGUgbnVtYmVyIG9mIGZhdGFsaXRpZXMgYnkgdGhlIG51bWJlciBvZiBwZW9wbGUgaW5qdXJlZCBpbiB0aGUgbWFzcyBzaG9vdGluZ3MuIElmIG9uZSBwdXRzIHRoZWlyIGN1cnNlciBvdmVyIGEgc3BlY2lmaWMgbWFya2VyIG9uIHRoZSBncmFwaCwgdGhlIG51bWJlcnMgd2lsbCBzaG93LiBGb3IgZXhhbXBsZSwgdGhlIG1hcmtlciBjbG9zZXIgdG8gNTAgb24gdGhlIHgtYXhpcyB3aWxsIHNob3cgKDQ5LDUzKSBtZWFuaW5nIHRoYXQgdGhlcmUgd2VyZSA0OSBmYXRhbGl0aWVzIGFuZCA1MyBwZW9wbGUgd2VyZSBpbmp1cmVkLiAKCjMuIFRoZSBmb2xsb3dpbmcgaXMgYSByZWdyZXNzaW9uIGFuYWx5c2lzIHRlc3RpbmcgdGhlIGh5cG90aGVzaXMgdGhhdCB0aGUgbnVtYmVyIG9mIG1hc3Mgc2hvb3RpbmdzIGhhdmUgaW5jcmVhc2VkIG92ZXIgdGhlIHllYXJzLiBBIGdyYXBoIGlzIGFsc28gaW5jbHVkZWQuIApgYGB7cn0Kc2hvb3RpbmdzX3Blcl95ZWFyIDwtIHNob290aW5ncyAlPiUKICBmaWx0ZXIoZmF0YWxpdGllcyA+IDMpICU+JQogIGNvdW50KHllYXIpCgpzaG9vdGluZ3NfcGVyX3llYXIKYGBgCmBgYHtyfQpzaG9vdGluZ3NfcGVyX3llYXJfbW9kZWwgPC0gbG0obiB+IHllYXIsIGRhdGEgPSBzaG9vdGluZ3NfcGVyX3llYXIpIAp0aWR5KHNob290aW5nc19wZXJfeWVhcl9tb2RlbCkKZ2xhbmNlKHNob290aW5nc19wZXJfeWVhcl9tb2RlbCkKCmBgYAoKYGBge3J9CnNob290aW5nc19wZXJfeWVhciAlPiUgCiAgcGxvdF9seSh4ID0gfnllYXIsIAogICAgICAgICAgeSA9IH5uLCBob3ZlcmluZm8gPSAidGV4dCIsIHRleHQgPSB+cGFzdGUoIk51bWJlciBvZiBzaG9vdGluZ3MgcGVyIHllYXI6ICIsIHJvdW5kKHNob290aW5nc19wZXJfeWVhciwgMSksICI8YnI+IiwgIlllYXI6ICIsIHllYXIpKSAlPiUgCiAgYWRkX21hcmtlcnMoc2hvd2xlZ2VuZCA9IEYpICU+JQogIGFkZF9saW5lcyh5ID0gfmZpdHRlZChzaG9vdGluZ3NfcGVyX3llYXJfbW9kZWwpKSAlPiUKICBsYXlvdXQodGl0bGUgPSAiTnVtYmVyIG9mIHNob290aW5ncyBwZXIgeWVhciIsIHhheGlzID0gbGlzdCh0aXRsZSA9ICJZZWFyIiksIHlheGlzID0gbGlzdCh0aXRsZSA9ICJOdW1iZXIgb2Ygc2hvb3RpbmdzIikpCgpgYGAKSW4gdGhpcyByZWdyZXNzaW9uIGFuYWx5c2lzLCB0aGUgaHlwb3RoZXNpcyB0aGF0IHRoZSBudW1iZXIgb2YgbWFzcyBzaG9vdGluZ3MgcGVyIHllYXIgaGF2ZSBpbmNyZWFzZWQgd2FzIHRlc3RlZC4gVGhlIHAtdmFsdWUgb2YgMC4wMDAxIGlzIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQgYmVjYXVzZSBpdCBpcyBiZWxvdyAwLjA0LiBIYXZpbmcgYSBzdGF0aXN0aWNhbGx5IHNpZ25pZmljYW50IHAtdmFsdWUgaW5kaWNhdGVzIHRoYXQgdGhlIGh5cG90aGVzaXMgaXMgdHJ1ZS4gRnVydGhlcm1vcmUsIHRoZSBncmFwaCBzaG93cyB0aGF0IHRoZSBudW1iZXIgb2YgbWFzcyBzaG9vdGluZ3MgcGVyIHllYXIgaGFzIGluY3JlYXNlZC4gVGhpcyBpcyBzZWVuIHdpdGggdGhlIHBvc2l0aXZlIHNsb3BlIG9mIHRoZSBvcmFuZ2UgbGluZS4gCgoKCgo=