Load packages

library(prophet)

Prepare the data

Let’s see how we do for ramen search popularity.

ramen_timeseries <- food_timeseries %>% 
  filter(keyword == 'ramen') %>% 
  select(date, hits) %>% 
  mutate(date = ymd(date)) %>% 
  rename(ds = date, y = hits) %>% # CONVERT COLUMN HEADERS FOR PROPHET
  arrange(ds) # ARRANGE BY DATE

Build the model

ramen_m <- prophet(ramen_timeseries)
ramen_future <- make_future_dataframe(ramen_m, periods = 365) # PREDICT 365 DAYS
ramen_ftdata <- as_tibble(predict(ramen_m, ramen_future))

Combine forecast with actuals

ramen_forecast <- ramen_ftdata %>% 
  mutate(ds = ymd(ds),
         segment = case_when(ds > Sys.Date()-7 ~ 'forecast',
                             TRUE ~ 'actual'), # SEGMENT ACTUAL VS FORECAST DATA
         keyword = paste0("ramen")) %>% 
  select(ds, segment, yhat_lower, yhat, yhat_upper, keyword) %>% 
  left_join(ramen_timeseries) # JOIN ACTUAL DATA

Plot forecasting results

ramen_forecast %>% 
  rename(date = ds,
         actual = y) %>% 
  ggplot() +
  geom_line(aes(date, actual)) + # PLOT ACTUALS DATA
  geom_point(data = subset(ramen_forecast, segment == 'forecast'),
            aes(ds, yhat), color = 'salmon', size = 0.1) + # PLOT PREDICTION DATA
  geom_ribbon(data = subset(ramen_forecast, segment == 'forecast'),
            aes(ds, ymin = yhat_lower, ymax = yhat_upper), 
            fill = 'salmon', alpha = 0.3) + # SHADE PREDICTION DATA REGION
  scale_y_continuous(limits = c(0,100)) +
  theme_bw() +
  labs(x = NULL, y = "Relative Search Interest",
       title = "Google Trends: interest over time for \"ramen\" (US)")

The chart above doesn’t look too bad however this is relative search popularity so we need to compare the prediction with pho and spaghetti as well.

# FUTURE NOTE: REFACTOR FOR DRY PRINCIPLES

# BUILD FORECASTING MODEL FOR PHO
pho_timeseries <- food_timeseries %>% 
  filter(keyword == 'pho') %>% 
  select(date, hits) %>% 
  mutate(date = ymd(date)) %>% 
  rename(ds = date, y = hits) %>% 
  arrange(ds)

pho_m <- prophet(pho_timeseries)
pho_future <- make_future_dataframe(pho_m, periods = 365)
pho_ftdata <- as_tibble(predict(pho_m, pho_future))

pho_forecast <- pho_ftdata %>% 
  mutate(ds = ymd(ds),
         segment = case_when(ds > Sys.Date()-7 ~ 'forecast',
                             TRUE ~ 'actual'),
         keyword = paste0("pho")) %>% 
  select(ds, segment, yhat_lower, yhat, yhat_upper, keyword) %>% 
  left_join(pho_timeseries)

# BUILD FORECASTING MODEL FOR SPAGHETTI
spaghetti_timeseries <- food_timeseries %>% 
  filter(keyword == 'spaghetti') %>% 
  select(date, hits) %>% 
  mutate(date = ymd(date)) %>% 
  rename(ds = date, y = hits) %>% 
  arrange(ds)

spaghetti_m <- prophet(spaghetti_timeseries)
spaghetti_future <- make_future_dataframe(spaghetti_m, periods = 365)
spaghetti_ftdata <- as_tibble(predict(spaghetti_m, spaghetti_future))

spaghetti_forecast <- spaghetti_ftdata %>% 
  mutate(ds = ymd(ds),
         segment = case_when(ds > Sys.Date()-7 ~ 'forecast',
                             TRUE ~ 'actual'),
         keyword = paste0("spaghetti")) %>% 
  select(ds, segment, yhat_lower, yhat, yhat_upper, keyword) %>% 
  left_join(spaghetti_timeseries)

# COMBINE ALL MODELS
keyword_forecast <- rbind(ramen_forecast, pho_forecast, spaghetti_forecast) %>% 
  rename(date = ds, actual = y)

Final plot

keyword_forecast %>% 
  ggplot() +
  geom_line(aes(date, actual, color = keyword), size = 1) +
  geom_ribbon(data = subset(keyword_forecast, segment == 'forecast'),
              aes(date, ymin = yhat_lower, ymax = yhat_upper, fill = keyword), 
            alpha = 0.3) +
  geom_point(data = subset(keyword_forecast, segment == 'forecast'),
             aes(date, yhat, color = keyword), size = 0.1) +
  scale_y_continuous(limits = c(0,100)) +
  scale_color_brewer(palette = 'Set2') +
  scale_fill_brewer(palette = 'Set2') +
  theme_bw() +
  labs(x = NULL, y = "Relative Search Interest",
       title = "Google Trends: interest over time (US)") 

One year from now we should expect to see ramen at the top followed by pho and spaghetti fighting for a close second in terms of relative search interest.

Load packages

library(tidytext)
library(igraph)
library(ggraph)

a <- grid::arrow(type = "closed", length = unit(.15, "inches"))

I’m curious: what is the relationship of the top queries for ramen, pho and spaghetti ?

Parse data and create graph

topqueries_bigram <- food_related %>% 
  filter(related_queries == 'top') %>% 
  unnest_tokens(bigram, value, token = 'ngrams', n = 3) %>% 
  separate(bigram, c("word1", "word2"), sep = " ") %>% 
  filter(!word1 %in% stop_words$word, !word2 %in% stop_words$word) %>% 
  count(word1, word2, sort = TRUE) %>% 
  filter(!is.na(word1), !is.na(word2)) %>% 
  graph_from_data_frame() 

Plot graph

set.seed(0612)

ggraph(topqueries_bigram, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = 'steelblue', size = 3) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void() +
  labs(title = "Google Trends: top queries (US)",
       caption = "by: @eeysirhc")

Not bad - we were able to visualize how spaghetti terms are relatively different and thus further away from its soupier Asian counterparts. Moreover, we were able to sift through the nosie and identify the related terms for each topic.

Now, just for fun, what about the relationship between rising queries?

Before we build our graph we want to spice things up a bit by adding an additional layer on top of the data. In this case, varying the size and color of our nodes based on the number of word occurrences.

word_counts <- food_related %>% 
  select(value) %>% 
  unnest_tokens(word, value) %>% 
  count(word, sort = TRUE) %>% 
  filter(!word %in% stop_words$word)

Parse data and create graph

risingqueries_bigram <- food_related %>% 
  filter(related_queries == 'rising') %>% 
  unnest_tokens(bigram, value, token = 'ngrams', n = 3) %>% 
  separate(bigram, c("word1", "word2"), sep = " ") %>% 
  filter(!word1 %in% stop_words$word, !word2 %in% stop_words$word) %>%
  count(word1, word2, sort = TRUE) %>% 
  filter(!is.na(word1), !is.na(word2)) %>% 
  graph_from_data_frame(vertices = word_counts) 

Plot graph

set.seed(0613)

ggraph(risingqueries_bigram, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(aes(size = n, color = n)) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  scale_color_gradient2(low = 'salmon', high = 'seagreen', midpoint = 25) +
  theme_void() +
  theme(legend.position = 'none') +
  labs(title = 'Google Trends: rising queries (US)',
       caption = "by: @eeysirhc")