First I am getting the gun law rating which I obtained.
gun_law <- read.csv("C:/Users/mikha/OneDrive/Desktop/Data 608/Stories/gun_law_strength.csv")
states <- c(
"California", "New York", "Hawaii", "New Jersey", "Connecticut",
"Massachusetts", "Illinois", "Maryland", "Oregon", "Washington",
"Delaware", "Colorado", "Rhode Island", "Virginia", "Pennsylvania",
"New Mexico", "Minnesota", "Nevada", "Florida", "Vermont",
"North Carolina", "Nebraska", "Wisconsin", "Michigan", "Maine",
"Louisiana", "West Virginia", "South Carolina", "Tennessee",
"Indiana", "Iowa", "Texas", "Ohio", "Alabama", "North Dakota",
"Utah", "Kansas", "Missouri", "New Hampshire", "Kentucky",
"Alaska", "Arizona", "Oklahoma", "Wyoming", "South Dakota",
"Montana", "Georgia", "Idaho", "Arkansas", "Mississippi","District of Columbia"
)
ratings <- c(
86.5, 81.5, 79.5, 79.0, 78.5,
78.0, 77.0, 72.5, 66.5, 62.5,
60.0, 58.5, 57.5, 49.0, 40.0,
39.5, 38.5, 35.0, 33.5, 32.5,
31.0, 31.0, 28.0, 25.5, 20.5,
20.5, 20.0, 18.0, 16.5, 16.5,
15.5, 13.5, 13.0, 12.5, 11.5,
11.0, 9.5, 9.0, 9.0, 9.0,
9.0, 8.5, 7.5, 6.5, 5.5,
5.0, 5.0, 5.0, 4.5, 3.0,75
)
rating_categories <- cut(ratings,
breaks = c(0, 40, 50, 60, 70, Inf),
labels = c(1, 2, 3, 4, 5),
right = FALSE)
ratings_mapped <- as.integer(as.character(rating_categories))
state_data <- data.frame(
state = states,
abbreviation = c(
"CA", "NY", "HI", "NJ", "CT",
"MA", "IL", "MD", "OR", "WA",
"DE", "CO", "RI", "VA", "PA",
"NM", "MN", "NV", "FL", "VT",
"NC", "NE", "WI", "MI", "ME",
"LA", "WV", "SC", "TN", "IN",
"IA", "TX", "OH", "AL", "ND",
"UT", "KS", "MO", "NH", "KY",
"AK", "AZ", "OK", "WY", "SD",
"MT", "GA", "ID", "AR", "MS","DC"
),
rating = ratings_mapped
)
print(state_data)## state abbreviation rating
## 1 California CA 5
## 2 New York NY 5
## 3 Hawaii HI 5
## 4 New Jersey NJ 5
## 5 Connecticut CT 5
## 6 Massachusetts MA 5
## 7 Illinois IL 5
## 8 Maryland MD 5
## 9 Oregon OR 4
## 10 Washington WA 4
## 11 Delaware DE 4
## 12 Colorado CO 3
## 13 Rhode Island RI 3
## 14 Virginia VA 2
## 15 Pennsylvania PA 2
## 16 New Mexico NM 1
## 17 Minnesota MN 1
## 18 Nevada NV 1
## 19 Florida FL 1
## 20 Vermont VT 1
## 21 North Carolina NC 1
## 22 Nebraska NE 1
## 23 Wisconsin WI 1
## 24 Michigan MI 1
## 25 Maine ME 1
## 26 Louisiana LA 1
## 27 West Virginia WV 1
## 28 South Carolina SC 1
## 29 Tennessee TN 1
## 30 Indiana IN 1
## 31 Iowa IA 1
## 32 Texas TX 1
## 33 Ohio OH 1
## 34 Alabama AL 1
## 35 North Dakota ND 1
## 36 Utah UT 1
## 37 Kansas KS 1
## 38 Missouri MO 1
## 39 New Hampshire NH 1
## 40 Kentucky KY 1
## 41 Alaska AK 1
## 42 Arizona AZ 1
## 43 Oklahoma OK 1
## 44 Wyoming WY 1
## 45 South Dakota SD 1
## 46 Montana MT 1
## 47 Georgia GA 1
## 48 Idaho ID 1
## 49 Arkansas AR 1
## 50 Mississippi MS 1
## 51 District of Columbia DC 5gun_rating <- state_data %>%
select(abbreviation,rating) %>%
rename("state" = abbreviation)Using the API to gather the mortality data
df <- read.socrata("https://data.cdc.gov/resource/489q-934x.csv")
states <- c("rate_alaska", "rate_alabama", "rate_arkansas", "rate_arizona", "rate_california", "rate_colorado", "rate_connecticut", "rate_district_of_columbia", "rate_delaware", "rate_florida", "rate_georgia", "rate_hawaii", "rate_iowa", "rate_idaho", "rate_illinois", "rate_indiana", "rate_kansas", "rate_kentucky", "rate_louisiana", "rate_massachusetts", "rate_maryland", "rate_maine", "rate_michigan", "rate_minnesota", "rate_missouri", "rate_mississippi", "rate_montana", "rate_north_carolina", "rate_north_dakota", "rate_nebraska", "rate_new_hampshire", "rate_new_jersey", "rate_new_mexico", "rate_nevada", "rate_new_york", "rate_ohio", "rate_oklahoma", "rate_oregon", "rate_pennsylvania", "rate_rhode_island", "rate_south_carolina", "rate_south_dakota", "rate_tennessee", "rate_texas", "rate_utah", "rate_virginia", "rate_vermont", "rate_washington", "rate_wisconsin", "rate_west_virginia", "rate_wyoming")
# Renaming all columns according to state abbreviations
df <- rename(df,
AK = rate_alaska,
AL = rate_alabama,
AR = rate_arkansas,
AZ = rate_arizona,
CA = rate_california,
CO = rate_colorado,
CT = rate_connecticut,
DC = rate_district_of_columbia,
DE = rate_delaware,
FL = rate_florida,
GA = rate_georgia,
HI = rate_hawaii,
IA = rate_iowa,
ID = rate_idaho,
IL = rate_illinois,
IN = rate_indiana,
KS = rate_kansas,
KY = rate_kentucky,
LA = rate_louisiana,
MA = rate_massachusetts,
MD = rate_maryland,
ME = rate_maine,
MI = rate_michigan,
MN = rate_minnesota,
MO = rate_missouri,
MS = rate_mississippi,
MT = rate_montana,
NC = rate_north_carolina,
ND = rate_north_dakota,
NE = rate_nebraska,
NH = rate_new_hampshire,
NJ = rate_new_jersey,
NM = rate_new_mexico,
NV = rate_nevada,
NY = rate_new_york,
OH = rate_ohio,
OK = rate_oklahoma,
OR = rate_oregon,
PA = rate_pennsylvania,
RI = rate_rhode_island,
SC = rate_south_carolina,
SD = rate_south_dakota,
TN = rate_tennessee,
TX = rate_texas,
UT = rate_utah,
VA = rate_virginia,
VT = rate_vermont,
WA = rate_washington,
WI = rate_wisconsin,
WV = rate_west_virginia,
WY = rate_wyoming
)
df$year_and_quarter <- str_extract(df$year_and_quarter,"\\d\\d\\d\\d")unique(df$cause_of_death)## [1] "All causes"
## [2] "Alzheimer disease"
## [3] "COVID-19"
## [4] "Cancer"
## [5] "Chronic liver disease and cirrhosis"
## [6] "Chronic lower respiratory diseases"
## [7] "Diabetes"
## [8] "Drug overdose"
## [9] "Falls, ages 65 and over"
## [10] "Firearm-related injury"
## [11] "Heart disease"
## [12] "HIV disease"
## [13] "Homicide"
## [14] "Hypertension"
## [15] "Influenza and pneumonia"
## [16] "Kidney disease"
## [17] "Parkinson disease"
## [18] "Pneumonitis due to solids and liquids"
## [19] "Septicemia"
## [20] "Stroke"
## [21] "Suicide"
## [22] "Unintentional injuries"firearm_df <- df %>%
filter(cause_of_death == 'Firearm-related injury')head(firearm_df)## year_and_quarter time_period cause_of_death
## 1 2021 12 months ending with quarter Firearm-related injury
## 2 2021 3-month period Firearm-related injury
## 3 2021 12 months ending with quarter Firearm-related injury
## 4 2021 3-month period Firearm-related injury
## 5 2021 12 months ending with quarter Firearm-related injury
## 6 2021 3-month period Firearm-related injury
## rate_type unit rate_overall rate_sex_female rate_sex_male
## 1 Age-adjusted Deaths per 100,000 14.0 4.0 24.4
## 2 Age-adjusted Deaths per 100,000 13.6 4.0 23.4
## 3 Age-adjusted Deaths per 100,000 14.4 4.1 24.9
## 4 Age-adjusted Deaths per 100,000 14.8 4.2 25.7
## 5 Age-adjusted Deaths per 100,000 14.6 4.1 25.2
## 6 Age-adjusted Deaths per 100,000 15.5 4.4 26.9
## rate_age_1_4 rate_age_5_14 rate_age_15_24 rate_age_25_34 rate_age_35_44
## 1 NA NA NA NA NA
## 2 NA NA NA NA NA
## 3 NA NA NA NA NA
## 4 NA NA NA NA NA
## 5 NA NA NA NA NA
## 6 NA NA NA NA NA
## rate_age_45_54 rate_age_55_64 rate_65_74 rate_age_75_84 rate_age_85_plus AK
## 1 NA NA NA NA NA 23.0
## 2 NA NA NA NA NA 19.4
## 3 NA NA NA NA NA 25.2
## 4 NA NA NA NA NA 28.8
## 5 NA NA NA NA NA 24.8
## 6 NA NA NA NA NA 24.8
## AL AR AZ CA CO CT DC DE FL GA HI IA ID IL IN KS
## 1 24.6 22.9 16.7 8.8 16.3 6.1 21.9 14.7 13.8 18.3 3.8 11.0 17.5 14.8 17.6 17.4
## 2 26.4 22.4 16.7 8.7 18.2 6.0 20.7 13.7 13.9 18.5 5.4 9.3 17.1 12.5 16.7 16.0
## 3 25.2 23.1 17.9 9.1 16.9 7.0 22.4 16.4 14.3 19.4 4.6 10.8 16.4 14.6 18.0 17.0
## 4 27.6 27.2 18.4 9.1 18.0 8.0 20.4 19.8 14.2 20.7 6.2 11.1 14.7 15.9 17.0 16.1
## 5 25.7 23.0 17.9 9.2 16.3 7.2 23.9 16.8 14.1 20.0 4.9 10.7 17.2 15.3 18.4 17.8
## 6 26.4 21.1 19.0 9.5 15.4 7.3 28.7 17.9 14.1 21.5 5.5 12.8 18.1 19.8 20.9 20.7
## KY LA MA MD ME MI MN MO MS MT NC ND NE NH NJ NM
## 1 21.1 28.4 3.7 14.4 10.2 14.9 9.1 24.7 30.7 20.9 16.1 15.2 11.1 9.3 5.0 23.8
## 2 21.1 29.1 2.7 14.1 11.8 13.5 8.5 22.1 30.2 24.7 16.1 19.0 11.8 8.7 3.5 25.2
## 3 22.1 29.8 3.4 14.6 11.6 15.6 9.6 24.5 32.4 21.7 17.0 15.5 10.9 9.7 5.1 26.2
## 4 22.1 29.5 3.0 16.1 13.8 16.2 10.0 23.8 35.7 26.4 18.0 14.1 9.2 7.7 5.7 29.7
## 5 22.2 29.9 3.2 15.2 12.4 16.1 10.0 23.5 34.5 23.1 17.1 16.5 10.3 8.4 5.2 26.4
## 6 23.0 30.6 3.9 15.9 13.6 17.3 11.6 24.9 40.8 22.7 17.4 17.7 8.8 7.4 6.1 27.8
## NV NY OH OK OR PA RI SC SD TN TX UT VA VT WA WI
## 1 18.1 5.5 15.9 20.9 14.2 14.0 5.4 21.8 15.5 22.3 14.5 13.9 13.2 12.0 10.7 12.3
## 2 21.2 4.6 15.0 21.2 16.2 13.4 5.0 19.9 16.1 21.7 14.5 13.1 12.7 11.5 10.2 10.5
## 3 19.1 5.5 16.4 20.8 14.3 14.4 5.9 22.3 15.5 22.7 15.1 14.1 13.7 11.2 10.5 12.9
## 4 18.8 5.7 17.0 21.4 13.1 14.5 7.5 23.0 11.5 21.5 16.1 15.6 14.0 8.7 9.9 13.8
## 5 20.1 5.3 16.3 21.5 14.6 14.5 6.3 22.1 13.8 23.0 15.3 14.7 13.6 11.9 10.9 13.2
## 6 21.7 6.2 17.5 22.5 13.9 15.1 5.7 23.8 11.5 24.0 15.9 16.2 14.3 13.8 13.1 14.9
## WV WY
## 1 17.4 25.0
## 2 16.6 23.3
## 3 17.5 24.6
## 4 17.1 20.9
## 5 17.7 23.7
## 6 16.3 30.7colnames(firearm_df)## [1] "year_and_quarter" "time_period" "cause_of_death" "rate_type"
## [5] "unit" "rate_overall" "rate_sex_female" "rate_sex_male"
## [9] "rate_age_1_4" "rate_age_5_14" "rate_age_15_24" "rate_age_25_34"
## [13] "rate_age_35_44" "rate_age_45_54" "rate_age_55_64" "rate_65_74"
## [17] "rate_age_75_84" "rate_age_85_plus" "AK" "AL"
## [21] "AR" "AZ" "CA" "CO"
## [25] "CT" "DC" "DE" "FL"
## [29] "GA" "HI" "IA" "ID"
## [33] "IL" "IN" "KS" "KY"
## [37] "LA" "MA" "MD" "ME"
## [41] "MI" "MN" "MO" "MS"
## [45] "MT" "NC" "ND" "NE"
## [49] "NH" "NJ" "NM" "NV"
## [53] "NY" "OH" "OK" "OR"
## [57] "PA" "RI" "SC" "SD"
## [61] "TN" "TX" "UT" "VA"
## [65] "VT" "WA" "WI" "WV"
## [69] "WY"ab <- c( "AK","AL","AR","AZ","CA","CO","CT","DC","DE","FL","GA","HI","IA","ID","IL","IN","KS" , "KY","LA" ,"MA" , "MD","ME","MI","MN", "MO","MS","MT","NC","ND","NE","NH","NJ","NM","NV","NY","OH","OK" ,"OR","PA","RI","SC","SD","TN","TX","UT","VA","VT","WA","WI","WV","WY")firearm <- firearm_df %>%
pivot_longer(cols = all_of(ab),
names_to = "state",
values_to = "rate") %>%
select("year_and_quarter","state","rate") %>%
filter(year_and_quarter == 2023) %>%
slice(1:51)Merging the data to have the final dataframe to develop my maps
final_df <- left_join(firearm,gun_rating , by = "state")
str(final_df)## tibble [51 × 4] (S3: tbl_df/tbl/data.frame)
## $ year_and_quarter: chr [1:51] "2023" "2023" "2023" "2023" ...
## $ state : chr [1:51] "AK" "AL" "AR" "AZ" ...
## $ rate : num [1:51] 21.4 26.4 22.7 20 8.6 17 6.6 23.9 12.1 14.2 ...
## $ rating : int [1:51] 1 1 1 1 5 3 5 5 4 1 ...# Gun Law Rating heatmap
heat_map <- plot_geo(final_df, locations = ~state, text = ~state, z = ~rating) %>%
add_trace(type = "choropleth", colorscale = "Viridis", locationmode = "USA-states",
marker = list(line = list(color = "white", width = 0.5)),
colorbar = list(title = "Gun Law Rating")) %>%
layout(title = "Gun Law Rating by State",
geo = list(scope = "usa", projection = list(type = "albers usa"),
showlakes = TRUE, lakecolor = toRGB("white")),
annotations = list(list(x = 0.05, y = 1.00, xref = "paper", yref = "paper",
showarrow = FALSE, text = "Gun Law Rating",
font = list(size = 14), align = "center")))
# Firearm Mortality Rating heatmap
heat_map2 <- plot_geo(final_df, locations = ~state, text = ~state, z = ~rate) %>%
add_trace(type = "choropleth", colorscale = "Viridis", locationmode = "USA-states",
marker = list(line = list(color = "white", width = 0.5)),
colorbar = list(title = "Firearm Mortality Rating")) %>%
layout(title = "Firearm Mortality Rating by State",
geo = list(scope = "usa", projection = list(type = "albers usa"),
showlakes = TRUE, lakecolor = toRGB("white")),
annotations = list(list(x = 0.05, y = 1.00, xref = "paper", yref = "paper",
text = "Firearm Mortality Rating", showarrow = FALSE,
font = list(size = 14), align = "center")))Using an accessible color palette for high contrast and an interactive map. I think that I am able to create a map visualization that can quietly captures the audience’s attention using the techniques of Pre-conscious Vision mentioned in the previous week.
combined_heatmaps <- subplot(heat_map, heat_map2, nrows = 2, margin = 0.05)
combined_heatmaps <- combined_heatmaps %>%
layout(title = list(text = "Firearm Mortality 2023",x = 0.5,font = list(weight = "bold")))
combined_heatmapsAs this map taken from the data gathered in 2023 there seems to be a consist theme shown in the graphs, where the stricter the gun law the mortality rate seems to decrease. There are still some states like Illinois that have relatively strict gun laws but a relatively high mortality rate but the overall sentiment from the maps shows that stricter gun laws do seem to have a low mortality rate.
https://www.cdc.gov/nchs/pressroom/sosmap/firearm_mortality/firearm.htm
https://www.statista.com/statistics/1358692/leading-states-gun-law-strength-us/#:~:text=Leading%20states%20for%20gun%20law%20strength%20in%20the%20U.S.%202023&text=California%20led%20the%20way%20in,with%20a%20score%20of%2079.5.