library(tidyverse)
library(DT)
library(trendyy) # Package to access google search data
library(lubridate) # Handles dates and times
- Step one was to load the data onto the notebook.
psychologist <- trendy("psychologist")
psychologist %>%
get_interest() %>%
glimpse()
Observations: 261
Variables: 6
$ date [3m[90m<dttm>[39m[23m 2015-02-22, 2015-03-01, 2015-03-08, 2015-03-15, 2015-03-22, 2015-03-29, 2015-04-05, 2015-04-12, 2…
$ hits [3m[90m<int>[39m[23m 71, 70, 68, 66, 68, 61, 60, 67, 65, 66, 66, 67, 66, 61, 62, 62, 62, 59, 58, 61, 60, 63, 62, 62, 62…
$ keyword [3m[90m<chr>[39m[23m "psychologist", "psychologist", "psychologist", "psychologist", "psychologist", "psychologist", "p…
$ geo [3m[90m<chr>[39m[23m "world", "world", "world", "world", "world", "world", "world", "world", "world", "world", "world",…
$ gprop [3m[90m<chr>[39m[23m "web", "web", "web", "web", "web", "web", "web", "web", "web", "web", "web", "web", "web", "web", …
$ category [3m[90m<chr>[39m[23m "All categories", "All categories", "All categories", "All categories", "All categories", "All cat…
- The next step was to create a graph showing the number of hits for the word “psychologist” over a long period of time. It appears to increase just a little bit, year-to-year, as time goes on.
psychologist %>%
get_interest() %>%
ggplot(aes(x = date, y = hits)) +
geom_line() +
theme_minimal() +
labs(title = "Google Searches for Psychologist")

- In order to get a cleaner graph that is easier to read, we narrowed in down to months, rather than years.
psychologist %>%
get_interest() %>%
mutate(month = month(date)) %>%
group_by(month) %>%
summarize(hits_per_month = mean(hits)) %>%
ggplot(aes(x = month, y = hits_per_month)) +
geom_line() +
scale_x_discrete(limits = c(1:12))

- Next, we used the dma command in order to take a look at hits per region in the US.
psychologist_US <- trendy("psychologist", geo = "US", from = "2015-06-01", to = "2019-06-01")
psychologist_US %>%
get_interest_dma() %>%
datatable()
NA
- Next, we add another region (Canada) in order to compare the US to another location. According to the graph, it appears that the US pretty similar throughout the year to Canada.
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 = "Internet searches for 'psychologist' over time, by country")

- In order to look at the terms ‘psychologist’ compared to ‘psychiatrist’, we needed to combine the two datasets and make a graph.
psychologist_psychiatrist <- trendy(c("psychologist", "psychiatrist"), geo = "US")
psychologist_psychiatrist %>%
get_interest() %>%
ggplot(aes(x = date, y = hits, color = keyword)) +
geom_line()

- Finally, we wanted to compare the terms psychologist and psychiatrist to each other over an extended period of time. As you can see, it appears that, in general, ‘psychologist’ is searched for more ofte than ‘psychiatrist’.
psychologist_psychiatrist_images <- trendy(c("psychologist", "psychiatrist"), gprop = "images")
psychologist_psychiatrist_images %>%
get_interest() %>%
ggplot(aes(x=date, y= hits, color = keyword))+
geom_line()+
labs(title= "'Psychologist' vs. 'Psychiatrist' Google image searches over time")

LS0tCnRpdGxlOiAiVHJlbmR5eSAxIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgoKCgpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoRFQpCmxpYnJhcnkodHJlbmR5eSkgICAgICAgICAgICAgICAgIyBQYWNrYWdlIHRvIGFjY2VzcyBnb29nbGUgc2VhcmNoIGRhdGEKbGlicmFyeShsdWJyaWRhdGUpICAgICAgICAgICAgICAgIyBIYW5kbGVzIGRhdGVzIGFuZCB0aW1lcwpgYGAKCgoxLiBTdGVwIG9uZSB3YXMgdG8gbG9hZCB0aGUgZGF0YSBvbnRvIHRoZSBub3RlYm9vay4KCgpgYGB7cn0KcHN5Y2hvbG9naXN0IDwtIHRyZW5keSgicHN5Y2hvbG9naXN0IikKCnBzeWNob2xvZ2lzdCAlPiUgCiAgZ2V0X2ludGVyZXN0KCkgJT4lIAogIGdsaW1wc2UoKQpgYGAKCgoKCgoyLiAgVGhlIG5leHQgc3RlcCB3YXMgdG8gY3JlYXRlIGEgZ3JhcGggc2hvd2luZyB0aGUgbnVtYmVyIG9mIGhpdHMgZm9yIHRoZSB3b3JkICJwc3ljaG9sb2dpc3QiIG92ZXIgYSBsb25nIHBlcmlvZCBvZiB0aW1lLiBJdCBhcHBlYXJzIHRvIGluY3JlYXNlIGp1c3QgYSBsaXR0bGUgYml0LCB5ZWFyLXRvLXllYXIsIGFzIHRpbWUgZ29lcyBvbi4KCgpgYGB7cn0KcHN5Y2hvbG9naXN0ICU+JQogIGdldF9pbnRlcmVzdCgpICU+JSAKICBnZ3Bsb3QoYWVzKHggPSBkYXRlLCB5ID0gaGl0cykpICsKICBnZW9tX2xpbmUoKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHRpdGxlID0gIkdvb2dsZSBTZWFyY2hlcyBmb3IgUHN5Y2hvbG9naXN0IikKYGBgCgoKCjMuIEluIG9yZGVyIHRvIGdldCBhIGNsZWFuZXIgZ3JhcGggdGhhdCBpcyBlYXNpZXIgdG8gcmVhZCwgd2UgbmFycm93ZWQgaW4gZG93biB0byBtb250aHMsIHJhdGhlciB0aGFuIHllYXJzLiAKCgpgYGB7cn0KcHN5Y2hvbG9naXN0ICU+JQogIGdldF9pbnRlcmVzdCgpICU+JSAKICBtdXRhdGUobW9udGggPSBtb250aChkYXRlKSkgJT4lICAgICAgICAgICAgCiAgZ3JvdXBfYnkobW9udGgpICU+JSAgICAgICAgICAgICAgICAgICAgICAgIAogIHN1bW1hcml6ZShoaXRzX3Blcl9tb250aCA9IG1lYW4oaGl0cykpICU+JSAgICAgIAogIGdncGxvdChhZXMoeCA9IG1vbnRoLCB5ID0gaGl0c19wZXJfbW9udGgpKSArICAgIAogIGdlb21fbGluZSgpICsKICBzY2FsZV94X2Rpc2NyZXRlKGxpbWl0cyA9IGMoMToxMikpCgpgYGAKCgo0LiBOZXh0LCB3ZSB1c2VkIHRoZSBkbWEgY29tbWFuZCBpbiBvcmRlciB0byB0YWtlIGEgbG9vayBhdCBoaXRzIHBlciByZWdpb24gaW4gdGhlIFVTLgoKCmBgYHtyfQpwc3ljaG9sb2dpc3RfVVMgPC0gdHJlbmR5KCJwc3ljaG9sb2dpc3QiLCBnZW8gPSAiVVMiLCBmcm9tID0gIjIwMTUtMDYtMDEiLCB0byA9ICIyMDE5LTA2LTAxIikKYGBgCgpgYGB7cn0KcHN5Y2hvbG9naXN0X1VTICU+JQogIGdldF9pbnRlcmVzdF9kbWEoKSAlPiUgCiAgZGF0YXRhYmxlKCkKCmBgYAoKNS4gTmV4dCwgd2UgYWRkIGFub3RoZXIgcmVnaW9uIChDYW5hZGEpIGluIG9yZGVyIHRvIGNvbXBhcmUgdGhlIFVTIHRvIGFub3RoZXIgbG9jYXRpb24uIEFjY29yZGluZyB0byB0aGUgZ3JhcGgsIGl0IGFwcGVhcnMgdGhhdCB0aGUgVVMgcHJldHR5IHNpbWlsYXIgdGhyb3VnaG91dCB0aGUgeWVhciB0byBDYW5hZGEuCgpgYGB7cn0KcHN5Y2hvbG9naXN0X2NvdW50cmllcyA8LSB0cmVuZHkoInBzeWNob2xvZ2lzdCIsIGdlbyA9IGMoIlVTIiwgIkNBIiksIGZyb20gPSAiMjAxNS0wMS0wMSIsIHRvID0gIjIwMjAtMDEtMDEiKQpgYGAKCgpgYGB7cn0KcHN5Y2hvbG9naXN0X2NvdW50cmllcyAlPiUKICBnZXRfaW50ZXJlc3QoKSAlPiUgCiAgbXV0YXRlKG1vbnRoID0gbW9udGgoZGF0ZSkpICU+JSAgICAgICAgICAKICBncm91cF9ieShtb250aCwgZ2VvKSAlPiUgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICBzdW1tYXJpemUoaGl0c19wZXJfbW9udGggPSBtZWFuKGhpdHMpKSAlPiUgICAgICAgICAgIAogIGdncGxvdChhZXMoeCA9IG1vbnRoLCB5ID0gaGl0c19wZXJfbW9udGgsIGNvbG9yID0gZ2VvKSkgKyAgICAgICAKICBnZW9tX2xpbmUoKSArCiAgc2NhbGVfeF9kaXNjcmV0ZShsaW1pdHMgPSBjKDE6MTIpKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHRpdGxlID0gIkludGVybmV0IHNlYXJjaGVzIGZvciAncHN5Y2hvbG9naXN0JyBvdmVyIHRpbWUsIGJ5IGNvdW50cnkiKQoKYGBgCgoKCgoKCjYuIEluIG9yZGVyIHRvIGxvb2sgYXQgdGhlIHRlcm1zICdwc3ljaG9sb2dpc3QnIGNvbXBhcmVkIHRvICdwc3ljaGlhdHJpc3QnLCB3ZSBuZWVkZWQgdG8gY29tYmluZSB0aGUgdHdvIGRhdGFzZXRzIGFuZCBtYWtlIGEgZ3JhcGguCgoKYGBge3J9CnBzeWNob2xvZ2lzdF9wc3ljaGlhdHJpc3QgPC0gdHJlbmR5KGMoInBzeWNob2xvZ2lzdCIsICJwc3ljaGlhdHJpc3QiKSwgZ2VvID0gIlVTIikKYGBgCgpgYGB7cn0KcHN5Y2hvbG9naXN0X3BzeWNoaWF0cmlzdCAlPiUKICBnZXRfaW50ZXJlc3QoKSAlPiUKICBnZ3Bsb3QoYWVzKHggPSBkYXRlLCB5ID0gaGl0cywgY29sb3IgPSBrZXl3b3JkKSkgKwogIGdlb21fbGluZSgpCmBgYAoKNy4gRmluYWxseSwgd2Ugd2FudGVkIHRvIGNvbXBhcmUgdGhlIHRlcm1zIHBzeWNob2xvZ2lzdCBhbmQgcHN5Y2hpYXRyaXN0IHRvIGVhY2ggb3RoZXIgb3ZlciBhbiBleHRlbmRlZCBwZXJpb2Qgb2YgdGltZS4gQXMgeW91IGNhbiBzZWUsIGl0IGFwcGVhcnMgdGhhdCwgaW4gZ2VuZXJhbCwgJ3BzeWNob2xvZ2lzdCcgaXMgc2VhcmNoZWQgZm9yIG1vcmUgb2Z0ZSB0aGFuICdwc3ljaGlhdHJpc3QnLgoKCmBgYHtyfQpwc3ljaG9sb2dpc3RfcHN5Y2hpYXRyaXN0X2ltYWdlcyA8LSB0cmVuZHkoYygicHN5Y2hvbG9naXN0IiwgInBzeWNoaWF0cmlzdCIpLCBncHJvcCA9ICJpbWFnZXMiKQogIAoKcHN5Y2hvbG9naXN0X3BzeWNoaWF0cmlzdF9pbWFnZXMgJT4lIAogIGdldF9pbnRlcmVzdCgpICU+JSAKICBnZ3Bsb3QoYWVzKHg9ZGF0ZSwgeT0gaGl0cywgY29sb3IgPSBrZXl3b3JkKSkrCiAgZ2VvbV9saW5lKCkrCiAgbGFicyh0aXRsZT0gIidQc3ljaG9sb2dpc3QnIHZzLiAnUHN5Y2hpYXRyaXN0JyBHb29nbGUgaW1hZ2Ugc2VhcmNoZXMgb3ZlciB0aW1lIikKYGBgCgoKCgo=