library(tidyverse)
library(broom)
library(plotly)
library(tidycensus)      # gets census data that we can use to create maps
library(sf)              # helper package for mapping
library(leaflet)         # interactive mapping package
library(trendyy)
library(usdata)          

This first chunk gathers the data for how many times “guns” have been searched on google, by state.

guns <- trendy("guns", 
                   geo = "US", 
                   from = "2019-01-01", to = "2020-01-01")


guns_states <- guns %>%
  get_interest_region()

guns_states

The following chunk then takes that data and makes it into a graph

states %>% 
  rename(location = NAME) %>% 
  inner_join(guns_states) %>%
  ggplot() +                         # create graph
  geom_sf(aes(fill = hits)) +        # color states with hits
  scale_fill_viridis_c() +            # use the viridis colors
  coord_sf(datum = NA) +             # remove coordinates
  theme_minimal() +                  # remove background
  labs(title = "State google searches for 'guns'", fill = "Search volume")
Joining, by = "location"

states_leaflet <- get_acs(geography = "state",       # gets state by state data
                  variables = "B19013_001",          # this is state income
                  geometry = TRUE)                   # gets geometry (the maps)
Getting data from the 2016-2020 5-year ACS
Downloading feature geometry from the Census website.  To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
                  # shift_geo = T      

This chunk analyzes the file Firearm_death_rate.csv and reads it into the program for later analysis.

read.csv("Firearm_death_rate.csv")

Ths chunk then creates a graph using the Firearm_Death_Rate data. It shows the firearm death rate by state.

guns_colors <- colorNumeric(palette = "viridis", domain = guns_data$Rate)

states_leaflet %>% 
  rename(location = NAME) %>% 
  inner_join(guns_data) %>% 
  leaflet() %>% 
  addTiles() %>%
  addPolygons(weight = 1,
              fillColor = ~guns_colors(Rate), 
              label = ~paste0(location, ", Firearm death rate = ", Rate),
              highlight = highlightOptions(weight = 2)) %>% 
  setView(-95, 40, zoom = 4) %>% 
  addLegend(pal = guns_colors, values = ~ Rate)
Joining, by = "location"sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
Need '+proj=longlat +datum=WGS84'

The following chunk then takes the data from the google searches for ‘guns’ and the firearm death rates by state, and creates a scatterplot with the data.

guns_data %>% 
  drop_na() %>% 
  plot_ly(x = ~hits, 
          y = ~Rate,
          hoverinfo = "text", 
          text = ~paste("State: ", location, "<br>", "'Guns' search rate: ", hits, "<br>", "Firearm death rate: ", Rate)) %>% 
  add_markers(showlegend = F) %>% 
  add_lines(y = ~fitted(guns_model)) %>% 
  layout(title = "Relationship between google searches for 'guns' and firearm death rates, by state",
   xaxis = list(title = "Google search volume for 'guns'"),
   yaxis = list(title = "State firearm death rate, per capita"))

Let’s see what the correlation is between firearm deaths by state and search hits for the word ‘ammo’. This chunk is the same code used to see how many hits for ‘guns’ there were by state and will give us the same data for the word ‘ammo’.

ammo <- trendy("ammo", 
                   geo = "US", 
                   from = "2019-01-01", to = "2020-01-01")


ammo_states <- ammo %>%
  get_interest_region()

ammo_states

Let’s create a map for this one as well. The following chunk will make a choropleth map of the searches for ‘ammo’ by state.

states %>% 
  rename(location = NAME) %>% 
  inner_join(ammo_states) %>%
  ggplot() +                         # create graph
  geom_sf(aes(fill = hits)) +        # color states with hits
  scale_fill_viridis_c() +            # use the viridis colors
  coord_sf(datum = NA) +             # remove coordinates
  theme_minimal() +                  # remove background
  labs(title = "State google searches for 'ammo'", fill = "Search volume")
Joining, by = "location"

Now we will create another scatterplot with the data from the firearm_death_rates file and the searches for the word ‘ammo’ by state.

guns_data %>% 
  drop_na() %>% 
  plot_ly(x = ~hits, 
          y = ~Rate,
          hoverinfo = "text", 
          text = ~paste("State: ", location, "<br>", "'Ammo' search rate: ", hits, "<br>", "Firearm death rate: ", Rate)) %>% 
  add_markers(showlegend = F) %>% 
  add_lines(y = ~fitted(guns_model)) %>% 
  layout(title = "Relationship between google searches for 'ammo' and firearm death rates, by state",
   xaxis = list(title = "Google search volume for 'ammo'"),
   yaxis = list(title = "State firearm death rate, per capita"))
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShicm9vbSkNCmxpYnJhcnkocGxvdGx5KQ0KbGlicmFyeSh0aWR5Y2Vuc3VzKSAgICAgICMgZ2V0cyBjZW5zdXMgZGF0YSB0aGF0IHdlIGNhbiB1c2UgdG8gY3JlYXRlIG1hcHMNCmxpYnJhcnkoc2YpICAgICAgICAgICAgICAjIGhlbHBlciBwYWNrYWdlIGZvciBtYXBwaW5nDQpsaWJyYXJ5KGxlYWZsZXQpICAgICAgICAgIyBpbnRlcmFjdGl2ZSBtYXBwaW5nIHBhY2thZ2UNCmxpYnJhcnkodHJlbmR5eSkNCmxpYnJhcnkodXNkYXRhKSAgICAgICAgICANCmBgYA0KDQoNClRoaXMgZmlyc3QgY2h1bmsgZ2F0aGVycyB0aGUgZGF0YSBmb3IgaG93IG1hbnkgdGltZXMgImd1bnMiIGhhdmUgYmVlbiBzZWFyY2hlZCBvbiBnb29nbGUsIGJ5IHN0YXRlLg0KYGBge3J9DQpndW5zIDwtIHRyZW5keSgiZ3VucyIsIA0KICAgICAgICAgICAgICAgICAgIGdlbyA9ICJVUyIsIA0KICAgICAgICAgICAgICAgICAgIGZyb20gPSAiMjAxOS0wMS0wMSIsIHRvID0gIjIwMjAtMDEtMDEiKQ0KDQoNCmd1bnNfc3RhdGVzIDwtIGd1bnMgJT4lDQogIGdldF9pbnRlcmVzdF9yZWdpb24oKQ0KDQpndW5zX3N0YXRlcw0KYGBgDQoNClRoZSBmb2xsb3dpbmcgY2h1bmsgdGhlbiB0YWtlcyB0aGF0IGRhdGEgYW5kIG1ha2VzIGl0IGludG8gYSBncmFwaA0KYGBge3J9DQpzdGF0ZXMgJT4lIA0KICByZW5hbWUobG9jYXRpb24gPSBOQU1FKSAlPiUgDQogIGlubmVyX2pvaW4oZ3Vuc19zdGF0ZXMpICU+JQ0KICBnZ3Bsb3QoKSArICAgICAgICAgICAgICAgICAgICAgICAgICMgY3JlYXRlIGdyYXBoDQogIGdlb21fc2YoYWVzKGZpbGwgPSBoaXRzKSkgKyAgICAgICAgIyBjb2xvciBzdGF0ZXMgd2l0aCBoaXRzDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19jKCkgKyAgICAgICAgICAgICMgdXNlIHRoZSB2aXJpZGlzIGNvbG9ycw0KICBjb29yZF9zZihkYXR1bSA9IE5BKSArICAgICAgICAgICAgICMgcmVtb3ZlIGNvb3JkaW5hdGVzDQogIHRoZW1lX21pbmltYWwoKSArICAgICAgICAgICAgICAgICAgIyByZW1vdmUgYmFja2dyb3VuZA0KICBsYWJzKHRpdGxlID0gIlN0YXRlIGdvb2dsZSBzZWFyY2hlcyBmb3IgJ2d1bnMnIiwgZmlsbCA9ICJTZWFyY2ggdm9sdW1lIikNCmBgYA0KYGBge3J9DQpzdGF0ZXNfbGVhZmxldCA8LSBnZXRfYWNzKGdlb2dyYXBoeSA9ICJzdGF0ZSIsICAgICAgICMgZ2V0cyBzdGF0ZSBieSBzdGF0ZSBkYXRhDQogICAgICAgICAgICAgICAgICB2YXJpYWJsZXMgPSAiQjE5MDEzXzAwMSIsICAgICAgICAgICMgdGhpcyBpcyBzdGF0ZSBpbmNvbWUNCiAgICAgICAgICAgICAgICAgIGdlb21ldHJ5ID0gVFJVRSkgICAgICAgICAgICAgICAgICAgIyBnZXRzIGdlb21ldHJ5ICh0aGUgbWFwcykNCiAgICAgICAgICAgICAgICAgICMgc2hpZnRfZ2VvID0gVCAgICAgIA0KYGBgDQpUaGlzIGNodW5rIGFuYWx5emVzIHRoZSBmaWxlIEZpcmVhcm1fZGVhdGhfcmF0ZS5jc3YgYW5kIHJlYWRzIGl0IGludG8gdGhlIHByb2dyYW0gZm9yIGxhdGVyIGFuYWx5c2lzLg0KYGBge3J9DQpyZWFkLmNzdigiRmlyZWFybV9kZWF0aF9yYXRlLmNzdiIpDQpgYGANCg0KDQoNCg0KVGhzIGNodW5rIHRoZW4gY3JlYXRlcyBhIGdyYXBoIHVzaW5nIHRoZSBGaXJlYXJtX0RlYXRoX1JhdGUgZGF0YS4gSXQgc2hvd3MgdGhlIGZpcmVhcm0gZGVhdGggcmF0ZSBieSBzdGF0ZS4NCmBgYHtyfQ0KZ3Vuc19jb2xvcnMgPC0gY29sb3JOdW1lcmljKHBhbGV0dGUgPSAidmlyaWRpcyIsIGRvbWFpbiA9IGd1bnNfZGF0YSRSYXRlKQ0KDQpzdGF0ZXNfbGVhZmxldCAlPiUgDQogIHJlbmFtZShsb2NhdGlvbiA9IE5BTUUpICU+JSANCiAgaW5uZXJfam9pbihndW5zX2RhdGEpICU+JSANCiAgbGVhZmxldCgpICU+JSANCiAgYWRkVGlsZXMoKSAlPiUNCiAgYWRkUG9seWdvbnMod2VpZ2h0ID0gMSwNCiAgICAgICAgICAgICAgZmlsbENvbG9yID0gfmd1bnNfY29sb3JzKFJhdGUpLCANCiAgICAgICAgICAgICAgbGFiZWwgPSB+cGFzdGUwKGxvY2F0aW9uLCAiLCBGaXJlYXJtIGRlYXRoIHJhdGUgPSAiLCBSYXRlKSwNCiAgICAgICAgICAgICAgaGlnaGxpZ2h0ID0gaGlnaGxpZ2h0T3B0aW9ucyh3ZWlnaHQgPSAyKSkgJT4lIA0KICBzZXRWaWV3KC05NSwgNDAsIHpvb20gPSA0KSAlPiUgDQogIGFkZExlZ2VuZChwYWwgPSBndW5zX2NvbG9ycywgdmFsdWVzID0gfiBSYXRlKQ0KYGBgDQoNCg0KDQoNCg0KVGhlIGZvbGxvd2luZyBjaHVuayB0aGVuIHRha2VzIHRoZSBkYXRhIGZyb20gdGhlIGdvb2dsZSBzZWFyY2hlcyBmb3IgJ2d1bnMnIGFuZCB0aGUgZmlyZWFybSBkZWF0aCByYXRlcyBieSBzdGF0ZSwgYW5kIGNyZWF0ZXMgYSBzY2F0dGVycGxvdCB3aXRoIHRoZSBkYXRhLg0KYGBge3J9DQpndW5zX2RhdGEgJT4lIA0KICBkcm9wX25hKCkgJT4lIA0KICBwbG90X2x5KHggPSB+aGl0cywgDQogICAgICAgICAgeSA9IH5SYXRlLA0KICAgICAgICAgIGhvdmVyaW5mbyA9ICJ0ZXh0IiwgDQogICAgICAgICAgdGV4dCA9IH5wYXN0ZSgiU3RhdGU6ICIsIGxvY2F0aW9uLCAiPGJyPiIsICInR3Vucycgc2VhcmNoIHJhdGU6ICIsIGhpdHMsICI8YnI+IiwgIkZpcmVhcm0gZGVhdGggcmF0ZTogIiwgUmF0ZSkpICU+JSANCiAgYWRkX21hcmtlcnMoc2hvd2xlZ2VuZCA9IEYpICU+JSANCiAgYWRkX2xpbmVzKHkgPSB+Zml0dGVkKGd1bnNfbW9kZWwpKSAlPiUgDQogIGxheW91dCh0aXRsZSA9ICJSZWxhdGlvbnNoaXAgYmV0d2VlbiBnb29nbGUgc2VhcmNoZXMgZm9yICdndW5zJyBhbmQgZmlyZWFybSBkZWF0aCByYXRlcywgYnkgc3RhdGUiLA0KICAgeGF4aXMgPSBsaXN0KHRpdGxlID0gIkdvb2dsZSBzZWFyY2ggdm9sdW1lIGZvciAnZ3VucyciKSwNCiAgIHlheGlzID0gbGlzdCh0aXRsZSA9ICJTdGF0ZSBmaXJlYXJtIGRlYXRoIHJhdGUsIHBlciBjYXBpdGEiKSkNCmBgYA0KDQoNCkxldCdzIHNlZSB3aGF0IHRoZSBjb3JyZWxhdGlvbiBpcyBiZXR3ZWVuIGZpcmVhcm0gZGVhdGhzIGJ5IHN0YXRlIGFuZCBzZWFyY2ggaGl0cyBmb3IgdGhlIHdvcmQgJ2FtbW8nLiBUaGlzIGNodW5rIGlzIHRoZSBzYW1lIGNvZGUgdXNlZCB0byBzZWUgaG93IG1hbnkgaGl0cyBmb3IgJ2d1bnMnIHRoZXJlIHdlcmUgYnkgc3RhdGUgYW5kIHdpbGwgZ2l2ZSB1cyB0aGUgc2FtZSBkYXRhIGZvciB0aGUgd29yZCAnYW1tbycuDQoNCmBgYHtyfQ0KYW1tbyA8LSB0cmVuZHkoImFtbW8iLCANCiAgICAgICAgICAgICAgICAgICBnZW8gPSAiVVMiLCANCiAgICAgICAgICAgICAgICAgICBmcm9tID0gIjIwMTktMDEtMDEiLCB0byA9ICIyMDIwLTAxLTAxIikNCg0KDQphbW1vX3N0YXRlcyA8LSBhbW1vICU+JQ0KICBnZXRfaW50ZXJlc3RfcmVnaW9uKCkNCg0KYW1tb19zdGF0ZXMNCmBgYA0KTGV0J3MgY3JlYXRlIGEgbWFwIGZvciB0aGlzIG9uZSBhcyB3ZWxsLiBUaGUgZm9sbG93aW5nIGNodW5rIHdpbGwgbWFrZSBhIGNob3JvcGxldGggbWFwIG9mIHRoZSBzZWFyY2hlcyBmb3IgJ2FtbW8nIGJ5IHN0YXRlLg0KYGBge3J9DQpzdGF0ZXMgJT4lIA0KICByZW5hbWUobG9jYXRpb24gPSBOQU1FKSAlPiUgDQogIGlubmVyX2pvaW4oYW1tb19zdGF0ZXMpICU+JQ0KICBnZ3Bsb3QoKSArICAgICAgICAgICAgICAgICAgICAgICAgICMgY3JlYXRlIGdyYXBoDQogIGdlb21fc2YoYWVzKGZpbGwgPSBoaXRzKSkgKyAgICAgICAgIyBjb2xvciBzdGF0ZXMgd2l0aCBoaXRzDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19jKCkgKyAgICAgICAgICAgICMgdXNlIHRoZSB2aXJpZGlzIGNvbG9ycw0KICBjb29yZF9zZihkYXR1bSA9IE5BKSArICAgICAgICAgICAgICMgcmVtb3ZlIGNvb3JkaW5hdGVzDQogIHRoZW1lX21pbmltYWwoKSArICAgICAgICAgICAgICAgICAgIyByZW1vdmUgYmFja2dyb3VuZA0KICBsYWJzKHRpdGxlID0gIlN0YXRlIGdvb2dsZSBzZWFyY2hlcyBmb3IgJ2FtbW8nIiwgZmlsbCA9ICJTZWFyY2ggdm9sdW1lIikNCmBgYA0KDQpOb3cgd2Ugd2lsbCBjcmVhdGUgYW5vdGhlciBzY2F0dGVycGxvdCB3aXRoIHRoZSBkYXRhIGZyb20gdGhlIGZpcmVhcm1fZGVhdGhfcmF0ZXMgZmlsZSBhbmQgdGhlIHNlYXJjaGVzIGZvciB0aGUgd29yZCAnYW1tbycgYnkgc3RhdGUuDQoNCmBgYHtyfQ0KZ3Vuc19kYXRhICU+JSANCiAgZHJvcF9uYSgpICU+JSANCiAgcGxvdF9seSh4ID0gfmhpdHMsIA0KICAgICAgICAgIHkgPSB+UmF0ZSwNCiAgICAgICAgICBob3ZlcmluZm8gPSAidGV4dCIsIA0KICAgICAgICAgIHRleHQgPSB+cGFzdGUoIlN0YXRlOiAiLCBsb2NhdGlvbiwgIjxicj4iLCAiJ0FtbW8nIHNlYXJjaCByYXRlOiAiLCBoaXRzLCAiPGJyPiIsICJGaXJlYXJtIGRlYXRoIHJhdGU6ICIsIFJhdGUpKSAlPiUgDQogIGFkZF9tYXJrZXJzKHNob3dsZWdlbmQgPSBGKSAlPiUgDQogIGFkZF9saW5lcyh5ID0gfmZpdHRlZChndW5zX21vZGVsKSkgJT4lIA0KICBsYXlvdXQodGl0bGUgPSAiUmVsYXRpb25zaGlwIGJldHdlZW4gZ29vZ2xlIHNlYXJjaGVzIGZvciAnYW1tbycgYW5kIGZpcmVhcm0gZGVhdGggcmF0ZXMsIGJ5IHN0YXRlIiwNCiAgIHhheGlzID0gbGlzdCh0aXRsZSA9ICJHb29nbGUgc2VhcmNoIHZvbHVtZSBmb3IgJ2FtbW8nIiksDQogICB5YXhpcyA9IGxpc3QodGl0bGUgPSAiU3RhdGUgZmlyZWFybSBkZWF0aCByYXRlLCBwZXIgY2FwaXRhIikpDQpgYGANCg0KDQoNCg==