Assignment: Look up “psychologist” with trendyy.

  1. Here is a graph of interest “psychologist” over time.
psychologist <- trendy("psychologist")

flu %>% 
  glimpse()
List of 1
 $ :List of 7
  ..$ interest_over_time :'data.frame': 260 obs. of  7 variables:
  .. ..$ date    : POSIXct[1:260], format: "2017-02-19" "2017-02-26" "2017-03-05" "2017-03-12" ...
  .. ..$ hits    : int [1:260] 13 12 12 9 9 9 9 8 7 7 ...
  .. ..$ keyword : chr [1:260] "flu" "flu" "flu" "flu" ...
  .. ..$ geo     : chr [1:260] "world" "world" "world" "world" ...
  .. ..$ time    : chr [1:260] "today+5-y" "today+5-y" "today+5-y" "today+5-y" ...
  .. ..$ gprop   : chr [1:260] "web" "web" "web" "web" ...
  .. ..$ category: int [1:260] 0 0 0 0 0 0 0 0 0 0 ...
  ..$ interest_by_country:'data.frame': 250 obs. of  5 variables:
  .. ..$ location: chr [1:250] "Falkland Islands (Islas Malvinas)" "United States" "Cook Islands" "Northern Mariana Islands" ...
  .. ..$ hits    : int [1:250] NA 100 NA NA NA 85 NA NA 82 81 ...
  .. ..$ keyword : chr [1:250] "flu" "flu" "flu" "flu" ...
  .. ..$ geo     : chr [1:250] "world" "world" "world" "world" ...
  .. ..$ gprop   : chr [1:250] "web" "web" "web" "web" ...
  ..$ interest_by_region : NULL
  ..$ interest_by_dma    :'data.frame': 306 obs. of  5 variables:
  .. ..$ location: chr [1:306] "Tri-Cities TN-VA" "Jonesboro AR" "Bluefield-Beckley-Oak Hill WV" "Ft. Smith-Fayetteville-Springdale-Rogers AR" ...
  .. ..$ hits    : chr [1:306] "100" "97" "96" "95" ...
  .. ..$ keyword : chr [1:306] "flu" "flu" "flu" "flu" ...
  .. ..$ geo     : chr [1:306] "world" "world" "world" "world" ...
  .. ..$ gprop   : chr [1:306] "web" "web" "web" "web" ...
  ..$ interest_by_city   :'data.frame': 58 obs. of  5 variables:
  .. ..$ location: chr [1:58] "Chapmansboro" "Plano" "Louisville" "Raleigh" ...
  .. ..$ hits    : int [1:58] NA NA NA NA NA NA NA NA NA NA ...
  .. ..$ keyword : chr [1:58] "flu" "flu" "flu" "flu" ...
  .. ..$ geo     : chr [1:58] "world" "world" "world" "world" ...
  .. ..$ gprop   : chr [1:58] "web" "web" "web" "web" ...
  ..$ related_topics     :'data.frame': 40 obs. of  5 variables:
  .. ..$ subject       : chr [1:40] "100" "22" "15" "14" ...
  .. ..$ related_topics: chr [1:40] "top" "top" "top" "top" ...
  .. ..$ value         : chr [1:40] "Influenza" "Influenza vaccine" "Common cold" "Death" ...
  .. ..$ keyword       : chr [1:40] "flu" "flu" "flu" "flu" ...
  .. ..$ category      : int [1:40] 0 0 0 0 0 0 0 0 0 0 ...
  .. ..- attr(*, "reshapeLong")=List of 4
  ..$ related_queries    :'data.frame': 50 obs. of  5 variables:
  .. ..$ subject        : chr [1:50] "100" "53" "52" "31" ...
  .. ..$ related_queries: chr [1:50] "top" "top" "top" "top" ...
  .. ..$ value          : chr [1:50] "the flu" "flu shot" "flu symptoms" "spanish flu" ...
  .. ..$ keyword        : chr [1:50] "flu" "flu" "flu" "flu" ...
  .. ..$ category       : int [1:50] 0 0 0 0 0 0 0 0 0 0 ...
  .. ..- attr(*, "reshapeLong")=List of 4
  ..- attr(*, "class")= chr [1:2] "gtrends" "list"
 - attr(*, "class")= chr "trendy"
psychologist %>%
  get_interest() %>% 
  ggplot(aes(x = date, y = hits)) +
  geom_line()

About 2/3 of the way through 2020 interest in psychologist was at an all time high, on the contrary, interest in psychologist was at its lowest in right about 2018.

  1. This is a graph depicting monthly interest in psychology.
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))
Warning: Continuous limits supplied to discrete scale.
Did you mean `limits = factor(...)` or `scale_*_continuous()`?

According to this graph, interest in psychologist peaks around September (or month 9).

  1. Here is a datatable of interest by DMA.
psychologist_US <- trendy("psychologist", geo = "US", from = "2015-01-01", to = "2020-01-01")
psychologist_US %>%
  get_interest_dma() %>% 
  datatable()
NA

The number 1 spot goes to Bakersfield CA.

  1. This is a graph comparing US vs. Canadian interest in psychologist by month.
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")
`summarise()` has grouped output by 'month'. You can override using the `.groups` argument.
Warning: Continuous limits supplied to discrete scale.
Did you mean `limits = factor(...)` or `scale_*_continuous()`?

Interest in psychologist is similarly frequent in Canada and the United States.

  1. This graph compares interest in psychologist to psychiatrist over time.
psychologist_psychiatrist <- trendy(c("psychologist", "psychiatrist"), geo = "US")
psychologist_psychiatrist %>%
  get_interest() %>%
  ggplot(aes(x = date, y = hits, color = keyword)) +
  geom_line()

From the data diplayed in the graph, it appears that psychologist is more frequently looked up than psychiatrist.

  1. This graph compares interest in psychologist to psychiatrist in google images over time.
psychologist_images <- trendy(c("psychologist","psychiatrist"), gprop = "images")
 psychologist_images %>%
  get_interest() %>% 
  ggplot(aes(x = date, y = hits, color = keyword)) +       
  geom_line() +
  theme_minimal() +
  labs(title = "Google image searches for 'psychologist or psychiatrist'")

It is obvious in the graph that psychologist is more frequently looked at through images.

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpBc3NpZ25tZW50OiBMb29rIHVwICJwc3ljaG9sb2dpc3QiIHdpdGggdHJlbmR5eS4NCg0KMS4gSGVyZSBpcyBhIGdyYXBoIG9mIGludGVyZXN0ICJwc3ljaG9sb2dpc3QiIG92ZXIgdGltZS4NCg0KYGBge3J9DQpwc3ljaG9sb2dpc3QgPC0gdHJlbmR5KCJwc3ljaG9sb2dpc3QiKQ0KDQpmbHUgJT4lIA0KICBnbGltcHNlKCkNCmBgYA0KDQpgYGB7cn0NCnBzeWNob2xvZ2lzdCAlPiUNCiAgZ2V0X2ludGVyZXN0KCkgJT4lIA0KICBnZ3Bsb3QoYWVzKHggPSBkYXRlLCB5ID0gaGl0cykpICsNCiAgZ2VvbV9saW5lKCkNCmBgYA0KQWJvdXQgMi8zIG9mIHRoZSB3YXkgdGhyb3VnaCAyMDIwIGludGVyZXN0IGluIHBzeWNob2xvZ2lzdCB3YXMgYXQgYW4gYWxsIHRpbWUgaGlnaCwgb24gdGhlIGNvbnRyYXJ5LCBpbnRlcmVzdCBpbiBwc3ljaG9sb2dpc3Qgd2FzIGF0IGl0cyBsb3dlc3QgaW4gcmlnaHQgYWJvdXQgMjAxOC4NCg0KMi4gVGhpcyBpcyBhIGdyYXBoIGRlcGljdGluZyBtb250aGx5IGludGVyZXN0IGluIHBzeWNob2xvZ3kuDQoNCmBgYHtyfQ0KcHN5Y2hvbG9naXN0ICU+JQ0KICBnZXRfaW50ZXJlc3QoKSAlPiUgDQogIG11dGF0ZShtb250aCA9IG1vbnRoKGRhdGUpKSAlPiUgICAgICAgICAgICAjIENyZWF0ZSBhIG5ldyB2YXJpYWJsZSBjYWxsZWQgbW9udGgNCiAgZ3JvdXBfYnkobW9udGgpICU+JSAgICAgICAgICAgICAgICAgICAgICAgICMgQ29tYmluZSBtb250aHMgYWNyb3NzIHdlZWtzIGFuZCB5ZWFycw0KICBzdW1tYXJpemUoaGl0c19wZXJfbW9udGggPSBtZWFuKGhpdHMpKSAlPiUgICAgICAjIEF2ZXJhZ2UgbnVtYmVyIG9mIHNlYXJjaGVzIGZvciBlYWNoIG1vbnRoDQogIGdncGxvdChhZXMoeCA9IG1vbnRoLCB5ID0gaGl0c19wZXJfbW9udGgpKSArICAgICMgZ3JhcGggaXQNCiAgZ2VvbV9saW5lKCkgKw0KICBzY2FsZV94X2Rpc2NyZXRlKGxpbWl0cyA9IGMoMToxMikpDQoNCmBgYA0KQWNjb3JkaW5nIHRvIHRoaXMgZ3JhcGgsIGludGVyZXN0IGluIHBzeWNob2xvZ2lzdCBwZWFrcyBhcm91bmQgU2VwdGVtYmVyIChvciBtb250aCA5KS4NCg0KMy4gSGVyZSBpcyBhIGRhdGF0YWJsZSBvZiBpbnRlcmVzdCBieSBETUEuDQoNCmBgYHtyfQ0KcHN5Y2hvbG9naXN0X1VTIDwtIHRyZW5keSgicHN5Y2hvbG9naXN0IiwgZ2VvID0gIlVTIiwgZnJvbSA9ICIyMDE1LTAxLTAxIiwgdG8gPSAiMjAyMC0wMS0wMSIpDQpgYGANCg0KYGBge3J9DQpwc3ljaG9sb2dpc3RfVVMgJT4lDQogIGdldF9pbnRlcmVzdF9kbWEoKSAlPiUgDQogIGRhdGF0YWJsZSgpDQoNCmBgYA0KDQpUaGUgbnVtYmVyIDEgc3BvdCBnb2VzIHRvIEJha2Vyc2ZpZWxkIENBLg0KDQo0LiBUaGlzIGlzIGEgZ3JhcGggY29tcGFyaW5nIFVTIHZzLiBDYW5hZGlhbiBpbnRlcmVzdCBpbiBwc3ljaG9sb2dpc3QgYnkgbW9udGguDQoNCmBgYHtyfQ0KcHN5Y2hvbG9naXN0X2NvdW50cmllcyA8LSB0cmVuZHkoInBzeWNob2xvZ2lzdCIsIGdlbyA9IGMoIlVTIiwgIkNBIiksIGZyb20gPSAiMjAxNS0wMS0wMSIsIHRvID0gIjIwMjAtMDEtMDEiKQ0KYGBgDQoNCmBgYHtyfQ0KcHN5Y2hvbG9naXN0X2NvdW50cmllcyAlPiUNCiAgZ2V0X2ludGVyZXN0KCkgJT4lIA0KICBtdXRhdGUobW9udGggPSBtb250aChkYXRlKSkgJT4lICAgICAgICAgIA0KICBncm91cF9ieShtb250aCwgZ2VvKSAlPiUgICAgICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgc3VtbWFyaXplKGhpdHNfcGVyX21vbnRoID0gbWVhbihoaXRzKSkgJT4lICAgICAgICAgICANCiAgZ2dwbG90KGFlcyh4ID0gbW9udGgsIHkgPSBoaXRzX3Blcl9tb250aCwgY29sb3IgPSBnZW8pKSArICAgICAgIA0KICBnZW9tX2xpbmUoKSArDQogIHNjYWxlX3hfZGlzY3JldGUobGltaXRzID0gYygxOjEyKSkgKw0KICB0aGVtZV9taW5pbWFsKCkgKw0KICBsYWJzKHRpdGxlID0gIkludGVybmV0IHNlYXJjaGVzIGZvciAncHN5Y2hvbG9naXN0JyBvdmVyIHRpbWUsIGJ5IGNvdW50cnkiKQ0KDQpgYGANCkludGVyZXN0IGluIHBzeWNob2xvZ2lzdCBpcyBzaW1pbGFybHkgZnJlcXVlbnQgaW4gQ2FuYWRhIGFuZCB0aGUgVW5pdGVkIFN0YXRlcy4NCg0KNS4gVGhpcyBncmFwaCBjb21wYXJlcyBpbnRlcmVzdCBpbiBwc3ljaG9sb2dpc3QgdG8gcHN5Y2hpYXRyaXN0IG92ZXIgdGltZS4gIA0KDQpgYGB7cn0NCnBzeWNob2xvZ2lzdF9wc3ljaGlhdHJpc3QgPC0gdHJlbmR5KGMoInBzeWNob2xvZ2lzdCIsICJwc3ljaGlhdHJpc3QiKSwgZ2VvID0gIlVTIikNCmBgYA0KYGBge3J9DQpwc3ljaG9sb2dpc3RfcHN5Y2hpYXRyaXN0ICU+JQ0KICBnZXRfaW50ZXJlc3QoKSAlPiUNCiAgZ2dwbG90KGFlcyh4ID0gZGF0ZSwgeSA9IGhpdHMsIGNvbG9yID0ga2V5d29yZCkpICsNCiAgZ2VvbV9saW5lKCkNCmBgYA0KDQpGcm9tIHRoZSBkYXRhIGRpcGxheWVkIGluIHRoZSBncmFwaCwgaXQgYXBwZWFycyB0aGF0IHBzeWNob2xvZ2lzdCBpcyBtb3JlIGZyZXF1ZW50bHkgbG9va2VkIHVwIHRoYW4gcHN5Y2hpYXRyaXN0LiANCiANCjYuIFRoaXMgZ3JhcGggY29tcGFyZXMgaW50ZXJlc3QgaW4gcHN5Y2hvbG9naXN0IHRvIHBzeWNoaWF0cmlzdCBpbiBnb29nbGUgaW1hZ2VzIG92ZXIgdGltZS4gIA0KDQpgYGB7cn0NCnBzeWNob2xvZ2lzdF9pbWFnZXMgPC0gdHJlbmR5KGMoInBzeWNob2xvZ2lzdCIsInBzeWNoaWF0cmlzdCIpLCBncHJvcCA9ICJpbWFnZXMiKQ0KYGBgDQoNCmBgYHtyfQ0KIHBzeWNob2xvZ2lzdF9pbWFnZXMgJT4lDQogIGdldF9pbnRlcmVzdCgpICU+JSANCiAgZ2dwbG90KGFlcyh4ID0gZGF0ZSwgeSA9IGhpdHMsIGNvbG9yID0ga2V5d29yZCkpICsgICAgICAgDQogIGdlb21fbGluZSgpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgbGFicyh0aXRsZSA9ICJHb29nbGUgaW1hZ2Ugc2VhcmNoZXMgZm9yICdwc3ljaG9sb2dpc3Qgb3IgcHN5Y2hpYXRyaXN0JyIpDQoNCmBgYA0KSXQgaXMgb2J2aW91cyBpbiB0aGUgZ3JhcGggdGhhdCBwc3ljaG9sb2dpc3QgaXMgbW9yZSBmcmVxdWVudGx5IGxvb2tlZCBhdCB0aHJvdWdoIGltYWdlcy4gDQo=