library(tidyverse)
library(DT)
library(trendyy)                # Package to access google search data
library(lubridate)               # Handles dates and times

Assignment: Look up “psychologist” with trendyy.

Using R, with the help of the trendyy package, allows us to explore “Google Trends” data. This data shows us information about how many times a certain term has been searched for over time, for example. In this case, I would like to find out out frequently Google users have searched for the term “psychology”. I will then display this data in the form of a graph, followed by graphs of other related inquiries.

First, I’ll tell R to prepare to show the interest levels in the term “psychologist” (basically, how often it has been searched), and then I can begin to create graphs in R using that data.

psychologist <- trendy("psychologist")

psychologist %>% 
  get_interest() %>%
  1. Now I will tell R to display a graph showing the interest in the search term “psychology” across time. The graph shows us that the term has been on an upward trend consistently, with a few periodic pronounced dips. I am curious if there may be a clear explanation somewhere for those dips? That’s a question for another time, though.
psychologist %>%
  get_interest() %>% 
  ggplot(aes(x = date, y = hits)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Google searches for 'psychologist'")

  1. So, the graph above shows the interest in the search term “psychologist” over time from 2015 to 2020, but what if we want to see more detail? Now I will use R to create a graph of interest over the months. For whatever reason (maybe just coincidence?), it looks like there is a big spike in interest in the term every September.
psychologist %>%
  get_interest() %>% 
  mutate(month = month(date)) %>%            # Create a new variable called month
  group_by(month) %>%                        # Combine months across weeks and years
  summarize(hits_per_month = mean(hits)) %>%      # Average number of searches for each month
  ggplot(aes(x = month, y = hits_per_month)) +    # graph it
  geom_line() +
  scale_x_discrete(limits = c(1:12)) +
  theme_minimal() +
  labs(title = "Google Searches for 'Psychologist' by Month")

  1. The term Demographic Market Area refers to a set of categories that includes major cities and sometimes lumps them in with neighboring cities to form larger geographic groupings. I would like to see a table of how much interest the search term “psychologist” has generated for each of these Demographic Market Areas. From here, I could use the search box to see that Billings is counted on its own, but that Butte is lumped in with Bozeman.
psychologist_US <- trendy("psychologist", geo = "US", from = "2015-06-01", to = "2019-06-01")
psychologist_US %>%
  get_interest_dma() %>%
  datatable()
  1. Now I am curious, how does interest in the term “psychologist” compare when we view it for both the United States, and for Canada, when we see how interest has changed across the months? I will tell R to create a line graph showing both to display this for us. The interesting thing is, the two graph lines both reflect higher interest in September.
psychologist_countries <- trendy("psychologist", geo = c("US", "CA"), from = "2015-01-01", to = "2020-01-01")
psychologist_countries %>%
  get_interest() %>% 
  mutate(month = month(date)) %>%            
  group_by(month, geo) %>%                        
  summarize(hits_per_month = mean(hits)) %>%
  ggplot(aes(x = month, y = hits_per_month, color = geo)) +
  geom_line() +
  scale_x_discrete(limits = c(1:12)) +
  theme_minimal() +
  labs(title = "Google Searches for 'Psychologist' and 'Psychiatrist' by Month in US and Canada")

  1. So, we have taken a look at search interest trends for the term “psychologist,” but what would the graph look like if we also look at interest trends for the term “psychiatrist”? I’ll now tell R to put both of these terms on a graph to track their respective interest levels over time.
psychologist_psychiatrist <- trendy(c("psychologist", "psychiatrist"), geo = "US")
psychologist_psychiatrist %>%
  get_interest() %>%
  ggplot(aes(x = date, y = hits, color=keyword)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Google Searches for 'Psychologist' and 'Psychiatrist' Over Time")

  1. Of course, not all Google users are doing a general search–many of them are using Google Images specifically, becaues they are more interested in related images than in related webpages. So, now I am curious, what will the graph look like that displays interest in those same terms, both “psychologist” and “psychiatrist”, but only for those searches conducted with Google Images?
psychologistpsychiatrist_images <- trendy(c("psychologist", "psychiatrist"), gprop = "images")
psychologistpsychiatrist_images %>%
  get_interest() %>%
  ggplot (aes(x = date, y = hits, color = keyword)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Google Images Searches for 'Psychologist' and 'Psychiatrist' Over Time")

LS0tCnRpdGxlOiAiR29vZ2xlIHRyZW5kcyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoRFQpCmxpYnJhcnkodHJlbmR5eSkgICAgICAgICAgICAgICAgIyBQYWNrYWdlIHRvIGFjY2VzcyBnb29nbGUgc2VhcmNoIGRhdGEKbGlicmFyeShsdWJyaWRhdGUpICAgICAgICAgICAgICAgIyBIYW5kbGVzIGRhdGVzIGFuZCB0aW1lcwpgYGAKCkFzc2lnbm1lbnQ6IExvb2sgdXAgInBzeWNob2xvZ2lzdCIgd2l0aCB0cmVuZHl5LgoKVXNpbmcgUiwgd2l0aCB0aGUgaGVscCBvZiB0aGUgdHJlbmR5eSBwYWNrYWdlLCBhbGxvd3MgdXMgdG8gZXhwbG9yZSAiR29vZ2xlIFRyZW5kcyIgZGF0YS4gVGhpcyBkYXRhIHNob3dzIHVzIGluZm9ybWF0aW9uIGFib3V0IGhvdyBtYW55IHRpbWVzIGEgY2VydGFpbiB0ZXJtIGhhcyBiZWVuIHNlYXJjaGVkIGZvciBvdmVyIHRpbWUsIGZvciBleGFtcGxlLiBJbiB0aGlzIGNhc2UsIEkgd291bGQgbGlrZSB0byBmaW5kIG91dCBvdXQgZnJlcXVlbnRseSBHb29nbGUgdXNlcnMgaGF2ZSBzZWFyY2hlZCBmb3IgdGhlIHRlcm0gInBzeWNob2xvZ3kiLiBJIHdpbGwgdGhlbiBkaXNwbGF5IHRoaXMgZGF0YSBpbiB0aGUgZm9ybSBvZiBhIGdyYXBoLCBmb2xsb3dlZCBieSBncmFwaHMgb2Ygb3RoZXIgcmVsYXRlZCBpbnF1aXJpZXMuIAoKRmlyc3QsIEknbGwgdGVsbCBSIHRvIHByZXBhcmUgdG8gc2hvdyB0aGUgaW50ZXJlc3QgbGV2ZWxzIGluIHRoZSB0ZXJtICJwc3ljaG9sb2dpc3QiIChiYXNpY2FsbHksIGhvdyBvZnRlbiBpdCBoYXMgYmVlbiBzZWFyY2hlZCksIGFuZCB0aGVuIEkgY2FuIGJlZ2luIHRvIGNyZWF0ZSBncmFwaHMgaW4gUiB1c2luZyB0aGF0IGRhdGEuIAoKYGBge3J9CnBzeWNob2xvZ2lzdCA8LSB0cmVuZHkoInBzeWNob2xvZ2lzdCIpCgpwc3ljaG9sb2dpc3QgJT4lIAogIGdldF9pbnRlcmVzdCgpICU+JSAKYGBgCgoKMS4gTm93IEkgd2lsbCB0ZWxsIFIgdG8gZGlzcGxheSBhIGdyYXBoIHNob3dpbmcgdGhlIGludGVyZXN0IGluIHRoZSBzZWFyY2ggdGVybSAicHN5Y2hvbG9neSIgYWNyb3NzIHRpbWUuIFRoZSBncmFwaCBzaG93cyB1cyB0aGF0IHRoZSB0ZXJtIGhhcyBiZWVuIG9uIGFuIHVwd2FyZCB0cmVuZCBjb25zaXN0ZW50bHksIHdpdGggYSBmZXcgcGVyaW9kaWMgcHJvbm91bmNlZCBkaXBzLiBJIGFtIGN1cmlvdXMgaWYgdGhlcmUgbWF5IGJlIGEgY2xlYXIgZXhwbGFuYXRpb24gc29tZXdoZXJlIGZvciB0aG9zZSBkaXBzPyBUaGF0J3MgYSBxdWVzdGlvbiBmb3IgYW5vdGhlciB0aW1lLCB0aG91Z2guIAoKYGBge3J9CnBzeWNob2xvZ2lzdCAlPiUKICBnZXRfaW50ZXJlc3QoKSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gZGF0ZSwgeSA9IGhpdHMpKSArCiAgZ2VvbV9saW5lKCkgKwogIHRoZW1lX21pbmltYWwoKSArCiAgbGFicyh0aXRsZSA9ICJHb29nbGUgc2VhcmNoZXMgZm9yICdwc3ljaG9sb2dpc3QnIikKYGBgCgoKMi4gU28sIHRoZSBncmFwaCBhYm92ZSBzaG93cyB0aGUgaW50ZXJlc3QgaW4gdGhlIHNlYXJjaCB0ZXJtICJwc3ljaG9sb2dpc3QiIG92ZXIgdGltZSBmcm9tIDIwMTUgdG8gMjAyMCwgYnV0IHdoYXQgaWYgd2Ugd2FudCB0byBzZWUgbW9yZSBkZXRhaWw/IE5vdyBJIHdpbGwgdXNlIFIgdG8gY3JlYXRlIGEgZ3JhcGggb2YgaW50ZXJlc3Qgb3ZlciB0aGUgbW9udGhzLiBGb3Igd2hhdGV2ZXIgcmVhc29uIChtYXliZSBqdXN0IGNvaW5jaWRlbmNlPyksIGl0IGxvb2tzIGxpa2UgdGhlcmUgaXMgYSBiaWcgc3Bpa2UgaW4gaW50ZXJlc3QgaW4gdGhlIHRlcm0gZXZlcnkgU2VwdGVtYmVyLiAKCmBgYHtyfQpwc3ljaG9sb2dpc3QgJT4lCiAgZ2V0X2ludGVyZXN0KCkgJT4lIAogIG11dGF0ZShtb250aCA9IG1vbnRoKGRhdGUpKSAlPiUgICAgICAgICAgICAjIENyZWF0ZSBhIG5ldyB2YXJpYWJsZSBjYWxsZWQgbW9udGgKICBncm91cF9ieShtb250aCkgJT4lICAgICAgICAgICAgICAgICAgICAgICAgIyBDb21iaW5lIG1vbnRocyBhY3Jvc3Mgd2Vla3MgYW5kIHllYXJzCiAgc3VtbWFyaXplKGhpdHNfcGVyX21vbnRoID0gbWVhbihoaXRzKSkgJT4lICAgICAgIyBBdmVyYWdlIG51bWJlciBvZiBzZWFyY2hlcyBmb3IgZWFjaCBtb250aAogIGdncGxvdChhZXMoeCA9IG1vbnRoLCB5ID0gaGl0c19wZXJfbW9udGgpKSArICAgICMgZ3JhcGggaXQKICBnZW9tX2xpbmUoKSArCiAgc2NhbGVfeF9kaXNjcmV0ZShsaW1pdHMgPSBjKDE6MTIpKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHRpdGxlID0gIkdvb2dsZSBTZWFyY2hlcyBmb3IgJ1BzeWNob2xvZ2lzdCcgYnkgTW9udGgiKQoKYGBgCgoKMy4gVGhlIHRlcm0gRGVtb2dyYXBoaWMgTWFya2V0IEFyZWEgcmVmZXJzIHRvIGEgc2V0IG9mIGNhdGVnb3JpZXMgdGhhdCBpbmNsdWRlcyBtYWpvciBjaXRpZXMgYW5kIHNvbWV0aW1lcyBsdW1wcyB0aGVtIGluIHdpdGggbmVpZ2hib3JpbmcgY2l0aWVzIHRvIGZvcm0gbGFyZ2VyIGdlb2dyYXBoaWMgZ3JvdXBpbmdzLiBJIHdvdWxkIGxpa2UgdG8gc2VlIGEgdGFibGUgb2YgaG93IG11Y2ggaW50ZXJlc3QgdGhlIHNlYXJjaCB0ZXJtICJwc3ljaG9sb2dpc3QiIGhhcyBnZW5lcmF0ZWQgZm9yIGVhY2ggb2YgdGhlc2UgRGVtb2dyYXBoaWMgTWFya2V0IEFyZWFzLiBGcm9tIGhlcmUsIEkgY291bGQgdXNlIHRoZSBzZWFyY2ggYm94IHRvIHNlZSB0aGF0IEJpbGxpbmdzIGlzIGNvdW50ZWQgb24gaXRzIG93biwgYnV0IHRoYXQgQnV0dGUgaXMgbHVtcGVkIGluIHdpdGggQm96ZW1hbi4gCgpgYGB7cn0KcHN5Y2hvbG9naXN0X1VTIDwtIHRyZW5keSgicHN5Y2hvbG9naXN0IiwgZ2VvID0gIlVTIiwgZnJvbSA9ICIyMDE1LTA2LTAxIiwgdG8gPSAiMjAxOS0wNi0wMSIpCmBgYAoKYGBge3J9CnBzeWNob2xvZ2lzdF9VUyAlPiUKICBnZXRfaW50ZXJlc3RfZG1hKCkgJT4lCiAgZGF0YXRhYmxlKCkKYGBgCgoKNC4gTm93IEkgYW0gY3VyaW91cywgaG93IGRvZXMgaW50ZXJlc3QgaW4gdGhlIHRlcm0gInBzeWNob2xvZ2lzdCIgY29tcGFyZSB3aGVuIHdlIHZpZXcgaXQgZm9yIGJvdGggdGhlIFVuaXRlZCBTdGF0ZXMsIGFuZCBmb3IgQ2FuYWRhLCB3aGVuIHdlIHNlZSBob3cgaW50ZXJlc3QgaGFzIGNoYW5nZWQgYWNyb3NzIHRoZSBtb250aHM/IEkgd2lsbCB0ZWxsIFIgdG8gY3JlYXRlIGEgbGluZSBncmFwaCBzaG93aW5nIGJvdGggdG8gZGlzcGxheSB0aGlzIGZvciB1cy4gVGhlIGludGVyZXN0aW5nIHRoaW5nIGlzLCB0aGUgdHdvIGdyYXBoIGxpbmVzIGJvdGggcmVmbGVjdCBoaWdoZXIgaW50ZXJlc3QgaW4gU2VwdGVtYmVyLiAKCmBgYHtyfQpwc3ljaG9sb2dpc3RfY291bnRyaWVzIDwtIHRyZW5keSgicHN5Y2hvbG9naXN0IiwgZ2VvID0gYygiVVMiLCAiQ0EiKSwgZnJvbSA9ICIyMDE1LTAxLTAxIiwgdG8gPSAiMjAyMC0wMS0wMSIpCmBgYAoKYGBge3J9CnBzeWNob2xvZ2lzdF9jb3VudHJpZXMgJT4lCiAgZ2V0X2ludGVyZXN0KCkgJT4lIAogIG11dGF0ZShtb250aCA9IG1vbnRoKGRhdGUpKSAlPiUgICAgICAgICAgICAKICBncm91cF9ieShtb250aCwgZ2VvKSAlPiUgICAgICAgICAgICAgICAgICAgICAgICAKICBzdW1tYXJpemUoaGl0c19wZXJfbW9udGggPSBtZWFuKGhpdHMpKSAlPiUKICBnZ3Bsb3QoYWVzKHggPSBtb250aCwgeSA9IGhpdHNfcGVyX21vbnRoLCBjb2xvciA9IGdlbykpICsKICBnZW9tX2xpbmUoKSArCiAgc2NhbGVfeF9kaXNjcmV0ZShsaW1pdHMgPSBjKDE6MTIpKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHRpdGxlID0gIkdvb2dsZSBTZWFyY2hlcyBmb3IgJ1BzeWNob2xvZ2lzdCcgYW5kICdQc3ljaGlhdHJpc3QnIGJ5IE1vbnRoIGluIFVTIGFuZCBDYW5hZGEiKQoKYGBgCgoKNS4gU28sIHdlIGhhdmUgdGFrZW4gYSBsb29rIGF0IHNlYXJjaCBpbnRlcmVzdCB0cmVuZHMgZm9yIHRoZSB0ZXJtICJwc3ljaG9sb2dpc3QsIiBidXQgd2hhdCB3b3VsZCB0aGUgZ3JhcGggbG9vayBsaWtlIGlmIHdlIGFsc28gbG9vayBhdCBpbnRlcmVzdCB0cmVuZHMgZm9yIHRoZSB0ZXJtICJwc3ljaGlhdHJpc3QiPyBJJ2xsIG5vdyB0ZWxsIFIgdG8gcHV0IGJvdGggb2YgdGhlc2UgdGVybXMgb24gYSBncmFwaCB0byB0cmFjayB0aGVpciByZXNwZWN0aXZlIGludGVyZXN0IGxldmVscyBvdmVyIHRpbWUuIAoKYGBge3J9CnBzeWNob2xvZ2lzdF9wc3ljaGlhdHJpc3QgPC0gdHJlbmR5KGMoInBzeWNob2xvZ2lzdCIsICJwc3ljaGlhdHJpc3QiKSwgZ2VvID0gIlVTIikKYGBgCgpgYGB7cn0KcHN5Y2hvbG9naXN0X3BzeWNoaWF0cmlzdCAlPiUKICBnZXRfaW50ZXJlc3QoKSAlPiUKICBnZ3Bsb3QoYWVzKHggPSBkYXRlLCB5ID0gaGl0cywgY29sb3I9a2V5d29yZCkpICsKICBnZW9tX2xpbmUoKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHRpdGxlID0gIkdvb2dsZSBTZWFyY2hlcyBmb3IgJ1BzeWNob2xvZ2lzdCcgYW5kICdQc3ljaGlhdHJpc3QnIE92ZXIgVGltZSIpCmBgYAoKCjYuIE9mIGNvdXJzZSwgbm90IGFsbCBHb29nbGUgdXNlcnMgYXJlIGRvaW5nIGEgZ2VuZXJhbCBzZWFyY2gtLW1hbnkgb2YgdGhlbSBhcmUgdXNpbmcgR29vZ2xlIEltYWdlcyBzcGVjaWZpY2FsbHksIGJlY2F1ZXMgdGhleSBhcmUgbW9yZSBpbnRlcmVzdGVkIGluIHJlbGF0ZWQgaW1hZ2VzIHRoYW4gaW4gcmVsYXRlZCB3ZWJwYWdlcy4gU28sIG5vdyBJIGFtIGN1cmlvdXMsIHdoYXQgd2lsbCB0aGUgZ3JhcGggbG9vayBsaWtlIHRoYXQgZGlzcGxheXMgaW50ZXJlc3QgaW4gdGhvc2UgIHNhbWUgdGVybXMsIGJvdGggInBzeWNob2xvZ2lzdCIgYW5kICJwc3ljaGlhdHJpc3QiLCBidXQgb25seSBmb3IgdGhvc2Ugc2VhcmNoZXMgY29uZHVjdGVkIHdpdGggR29vZ2xlIEltYWdlcz8KCmBgYHtyfQpwc3ljaG9sb2dpc3Rwc3ljaGlhdHJpc3RfaW1hZ2VzIDwtIHRyZW5keShjKCJwc3ljaG9sb2dpc3QiLCAicHN5Y2hpYXRyaXN0IiksIGdwcm9wID0gImltYWdlcyIpCmBgYAoKYGBge3J9CnBzeWNob2xvZ2lzdHBzeWNoaWF0cmlzdF9pbWFnZXMgJT4lCiAgZ2V0X2ludGVyZXN0KCkgJT4lCiAgZ2dwbG90IChhZXMoeCA9IGRhdGUsIHkgPSBoaXRzLCBjb2xvciA9IGtleXdvcmQpKSArCiAgZ2VvbV9saW5lKCkgKwogIHRoZW1lX21pbmltYWwoKSArCiAgbGFicyh0aXRsZSA9ICJHb29nbGUgSW1hZ2VzIFNlYXJjaGVzIGZvciAnUHN5Y2hvbG9naXN0JyBhbmQgJ1BzeWNoaWF0cmlzdCcgT3ZlciBUaW1lIikKYGBgCgoKCg==