Rを使ったネット調査例。人々の「カレー」に対する注目を調べる。

●本記事でやること

これまでの記事を応用して以下を実施します。
・{gtrendsR} Google Trendsデータを利用し「カレー」が
　１日の内で何時頃？
　１週間の内の何曜日？
　１年の内でいつごろ？
　注目されるかを調べる。
・{prophet}により今後の「カレー」の注目度の予測を行う。
・{rtweet}により取得された「カレー」に関するツイートからRT上位ツイートを抜き出し、{wordcloud2}によってワードクラウドを作成、今現在のカレーに関するトピックを知る

●前置き

これまでの記事を応用し、Rを使って「カレー」についての簡単な市場調査を行います。Rを用いることで、いつ注目されるか？今後の注目度はどうなりそうか？最新の関連トピックは？などがすぐに分かるため、ルーチンで調査を行ったり、大量のワードの調査を行う際に有用です。

●「カレー」は一日のうちで何時ごろ最も注目（検索）されるか？

現代、人々が何かが欲しい時。何かを調べたい時。インターネットで求める物を検索します。例えば「カレー」を食べたい時。Googleで「カレー レシピ」や「カレー屋」などで検索するはずです。
このためGoogleで「カレー」がどんなタイミングで検索されているかを調べることで、人々が「カレー」に注目しているタイミングを知ることができます。このデータはGoogle Trendsで取得することができます。
Google TrendsのデータはCSVファイルとしてダウンロードすることもできますが、Rパッケージである{gtrendsR}を用いることでそのまま分析しやすい状態で取得することができます。

Google Trendsデータは期間によってデータ頻度が異なります。
例えば過去7日間データであれば1時間ごと24*7日分の検索数データが得られます。このデータを解析すれば一日のうちで何時頃に検索数が増えるかが分かります。
この解析に便利なのが{prophet}パッケージです。{prophet}は時系列予測に用いるパッケージですが、推定されたモデルの各成分を描写してくれるprophet_plot_components()という関数があります。
本来の使い方とは異なるかもしれませんが、モデルは過去のデータを学習しているため、推定モデルの日次時間成分を見ることで、一日のうちにどの時間に検索数が多かったかが分かります。

過去七日間のカレー検索数データは上のようになり、周期的に変動していることが分かります。

このデータについて{prophet}でdaily.seasonality = TRUEで良い感じにモデルを作成してやり、prophet_plot_components()してやると上のようなグラフが得られます。
これは推定モデルの日次時間成分であるため、すなわち過去七日間の学習の結果、このグラフのｙ軸が高い時間帯に検索数が増える傾向があることを示します。
見てわかる通り、11時及び18時前後、昼食と夕食の時間に検索数が増える、一方で朝食の時間にカレーを検索する方はほとんどいないことが分かります。
このことから、カレーのプロモーションは昼食か夕食の時間、または昼食・夕食向けに実施することが適切であることが分かります。
一方で朝食におけるカレー注目度が少ないことから、朝食カレー需要を伸ばす、という方向性もあるかもしれません。

●「カレー」は一週間のうちで何曜日に注目（検索）されるか？

上と同様のことをGoogle Trends 90日分のデータで行い、weekly.seasonality = TRUEでモデル化すると何曜日に検索されたかが分かります。

木曜日、土日に検索数が多いことが分かります。
土日にカレーが多いというのは、家庭でゆっくりカレーを作って食べる方が多いからかと思われますが、木曜日に多いのは意外です。
疲れが溜まってきた平日終盤に元気を出すためにカレーを食べるのかもしれませんね。

●「カレー」は一年のうちでいつ注目（検索）されるか？またカレーのトレンドは上昇傾向であるか？

同様に5年分のデータに対してyearly.seasonality = TRUEでモデル化すると、一年のうちでいつ検索されたかが分かります。

上のグラフはトレンド成分の変化です。「カレー」の検索数は徐々に上がってきていることが分かります。
下のグラフは年次成分の変化です。
2月・5月・8月くらいに検索数が多いタイミングがあるようであり、年末年始は少ないです。7月に一度落ち込むことを見るに、梅雨の時期は注目されにくくなるのかもしれません。通年を通して食べられるカレーですが、その注目度には波があることが分かります。

●カレー注目度の今後一年間の予測

せっかくprophetでモデル化しましたので今後一年間の予測をプロットしてみます。予測を出すことでカレー関連のプロモーションをかける時期はいつが良いかなどが分かります。

●カレーに関するトピックを調べる

Twitterでは日々カレーのレシピや、どんなカレーを食べたかなどがツイートされ、リツイート数や良いね数が高いツイートはそれだけ多くの人の注目を集めていると言えます。
{rtweet}で「カレー」を含むTwitterデータを収集し、RT上位のトピックをワードクラウド図で描写しました。これによってカレーに関してどのような話題が注目を集めているかが分かる筈です。

一番多いのは「作る」ですね。「カレー」はやはり外食ではなく作るものという声が大きいようです。自粛の影響も大きいかもしれません。
その他、「自販機」。Twitterでカレー自販機などのレトロ自販機に関するニュース記事が話題になっていたようです。
その他、カレーに合わせる素材やブランドなどカレーに関する話題のワードが分かります。具体的にはTwitterを確認したり、ニュース検索することでなぜ話題になっているのかを深堀りすることができます。

●まとめ

いかがでしたでしょうか。
Rを使ったネット調査の一例を示しました。今回の調査法は急にバズったものではなく、すでに生活に溶け込んでいるモノを調べる際に適しています。食べ物、趣味、イベント、アーティスト等々、様々なワードに対する有益な情報や性質を調べることができます。
プロモーション等の参考になりましたら幸いです。

●使用したコード

分析に使用したコードや分析についてご相談がございましたらTwitterのDMにご連絡ください。

以下は使用したRのコードです。

# load library
library(tidyverse)
library(lubridate)
library(gtrendsR)
library(stringi)
library(prophet)
library(scales)

search_words <- "カレー"
# set locale to avoid MS invalid multibyte error
Sys.setlocale("LC_ALL","English")

# 7days for daily
res <- gtrends(
 keyword = stri_encode(search_words, "", "utf-8"), # search word
 geo = "JP", # search location
 time = "now 7-d"
 )

dat7d <- res$interest_over_time %>% 
 as_tibble() %>% 
 mutate(ds = ymd_hms(date) + 9*60*60) %>% # to JP tz
 mutate(y = hits) %>% 
 select(ds,y)
# line plot
dat7d %>%
 ggplot() +
 geom_line(aes(x = ds, y = y), size = 0.5) +
 scale_color_brewer(palette = 'Set2') +
 scale_x_datetime(date_breaks = "6 hours", 
                  labels = date_format(format = "%H:%M:%S", 
                                       tz = "Asia/Tokyo")) +
 theme_bw() +
 labs(x = NULL,
      y = "hits",
      color = NULL,
      title = "Google trends カレー検索数")

model <- dat7d %>%
 prophet(growth = "linear", # or "logistic" 線形トレンドか非線形トレンドか
         # yearly.seasonality = TRUE,
         weekly.seasonality = TRUE,
         daily.seasonality = TRUE,
         seasonality.mode = "multiplicative", # or "additive"
         changepoint.prior.scale = 0.05, # トレンド変化点での傾きの変化の大きさ
         changepoint.range = 1, # default0.8, 1で直近のデータまでトレンド変化予想に使用する
         n.changepoints = 25　# トレンド変化点候補の数default25
 )

future <- make_future_dataframe(model, 1) # predict a year
pred <- predict(model, future)
prophet_plot_components(model, pred) # plot component


# 90days for weeky
res <- gtrends(
 keyword = stri_encode(search_words, "", "utf-8"), # search word
 geo = "JP", # search location
 time = "today 3-m"
)
dat90d<- res$interest_over_time %>% 
 as_tibble() %>% 
 mutate(ds = ymd(date)) %>%
 mutate(y = hits) %>% 
 select(ds, y)

# line plot
dat90d %>%
 ggplot() +
 geom_line(aes(x= ds, y= y), size = 0.5) +
 scale_color_brewer(palette = 'Set2') +
 scale_x_date(date_breaks = "7 days") +
 theme_bw() +
 labs(x = NULL,
      y = "hits",
      color = NULL,
      title = "Google trends カレー検索数")

model <- dat90d %>%
 prophet(growth = "linear", # or "logistic" 線形トレンドか非線形トレンドか
         # yearly.seasonality = TRUE,
         weekly.seasonality = TRUE,
         daily.seasonality = FALSE,
         seasonality.mode = "multiplicative", # or "additive"
         changepoint.prior.scale = 0.05, # トレンド変化点での傾きの変化の大きさ
         changepoint.range = 1, # default0.8, 1で直近のデータまでトレンド変化予想に使用する
         n.changepoints = 25　# トレンド変化点候補の数default25
 )
future <- make_future_dataframe(model, 1) # predict a year
pred <- predict(model, future)
prophet_plot_components(model,pred) # plot component


# 5 years for years
res <- gtrends(
 keyword = stri_encode(search_words, "", "utf-8"), # search word
 geo = "JP", # search location
 time = "today+5-y"
)
dat5y<- res$interest_over_time %>% 
 as_tibble() %>% 
 mutate(ds = ymd(date)) %>%
 mutate(y = hits) %>% 
 select(ds,y)
model <- dat5y %>%
 prophet(growth = "linear", # or "logistic" 線形トレンドか非線形トレンドか
         yearly.seasonality = TRUE,
         seasonality.mode = "multiplicative", # or "additive"
         changepoint.prior.scale = 0.05, # トレンド変化点での傾きの変化の大きさ
         changepoint.range = 1, # default0.8, 1で直近のデータまでトレンド変化予想に使用する
         n.changepoints = 25　# トレンド変化点候補の数default25
 )
future <- make_future_dataframe(model, 365) # predict a year
pred <- predict(model, future)
ftdata <- as_tibble(predict(model, future))
plot(model, pred) # plot
prophet_plot_components(model,pred) # plot component

forecast <- ftdata %>%
 mutate(ds = ymd(ds),
        segment = case_when(ds > dat5y$ds[nrow(dat5y)] - 2 ~ 'forecast',
                            TRUE ~ 'actual'), # SEGMENT ACTUAL VS FORECAST DATA
        keyword = paste0("word")) %>%
 select(ds, segment, yhat_lower, yhat, yhat_upper, keyword) %>%
 left_join(dat5y) # JOIN ACTUAL DATA

g_30 <- forecast %>%
 dplyr::filter(ds >= Sys.Date() - 365) %>%
 rename(date = ds,
        actual = y) %>%
 ggplot() +
 geom_line(aes(date, actual)) + # PLOT ACTUALS DATA
 geom_line(data = subset(forecast, segment == 'forecast'),
           aes(ds, yhat), color = 'steelblue', size = 0.1) + # PLOT PREDICTION DATA
 geom_ribbon(data = subset(forecast, segment == 'forecast'),
             aes(ds, ymin = yhat_lower, ymax = yhat_upper),
             fill = 'skyblue', alpha = 0.3) + # alpha for prediction region
 theme_bw() +
 scale_x_date(breaks = function(x) seq.Date(from = ymd(min(forecast$ds)), to = ymd(max(forecast$ds)), by= "1 month"), date_labels= "%m/%d") + # x label date_breaks by 30 days
 labs(x = "Date", y = "検索割合",
      title = "ピーク時を100としたときの検索割合の推移（キーワード：カレー）実データ (黒線) 今後の予測 (青線) by {prophet}")
suppressWarnings(print(g_30))

# restore locale to JP
Sys.setlocale("LC_CTYPE", "Japanese_Japan.932")

# Twitterテキストを収集し流行ツイートからワードクラウド図を描く
require("rtweet")
require("wordcloud2")
require("RMeCab")
# tokenの設定
twitter_token <- create_token(app = "YOURAPPNAMES", # 自分で設定したappの名前
                             consumer_key = "****", # Consumer Keyを入力
                             consumer_secret = "****", # Consumer Secretを入力
                             access_token = "****", 
                             access_secret = "****")

# search_wordの設定
x = "カレー"
# ツイートの収集 type = "mixed" と include_rts = TRUE でよくリツイートされるツイートを収集します。
rt <- search_tweets(
 q=x,
 n = 18000, 
 retryonratelimit = FALSE, 
 type = "mixed", 
 include_rts = TRUE
)

# データの整理
rt2 <- rt %>%
 distinct(text, retweet_text, .keep_all = TRUE) %>% # 重複リツイートを消す。
 arrange(desc(retweet_count)) %>%
 filter(retweet_count > 100) # リツイート上位100位を抽出
# テキストデータの準備
rt2$text <- rt2$text %>%
 str_replace_all(pattern = '\\p{ASCII}',replacement = "") # 記号を消します。
rt_text <- rt2$text %>% 
 na.omit() %>% 
 iconv(from = "UTF-8", to = "CP932") %>%  # windowsのみEncodeの変更が必要です。
 paste(collapse = "")    # テキストを結合
textfile <- tempfile()    # 一時ファイルの入れ物を作成
write(rt_text, textfile) # docDFで読むために一時ファイルを作成
cloud <- docDF(textfile, type = 1)
unlink(textfile) # 一時ファイル消去
cloud <- cloud %>% 
 select(everything(), FREQ = starts_with("file")) %>% # 4列目のfile****....という名前が長いためFREQへ変更
 arrange(desc(FREQ))

# 消したい不要なワードを設定
exclude_word = c("する","なる","やる","ある","いる","①","②","③","-","♪","NA","NANA","NANANA","NANANANA","	　＃","#",x)
# 動詞と名詞で良い感じのやつを残す
cloud2 <- cloud %>%
 filter(grepl(pattern = "動詞|名詞", x = POS1) &
        !grepl(pattern = "助動詞|代名詞", x = POS1) &
        !grepl(pattern = "非自立|接尾|数|代名詞", x = POS2)
 ) %>%
 filter(!TERM %in% exclude_word)

# ワードクラウド図を書く
# Takaoフォント様 https://launchpad.net/takao-fonts
cloud2 %>%
 select(TERM,FREQ) %>%
 slice(3:100) %>% # 描画する範囲を設定
 wordcloud2(fontFamily = 'Takao Pゴシック', color = "steelblue", minRotation = 0, maxRotation = 0, size = 0.5)