トピックモデルで１週間の献立をレコメンドする衝動遊戯：第１ゲーム

【ABSTRACT】

料理において、最も面倒くさいことの1つが献立決めである。献立決めのレコメンドエンジンを作れば、この料理への心理的障壁を乗り越えることができる。料理の献立決めのレコメンドエンジンの要件として、同じようなものが続けてレコメンドされないことが求められる。なぜならば、同じものばかりでは飽きてしまうし、栄養の偏りも出てしまうためだ。したがって、この記事では、クックパッドのレシピに、トピックモデルを適用して、レシピをトピックごとにクラスタリングし、クラスタ別で1週間分のレシピを提案するレコメンドエンジンを作成する。

【OBJECTIVE】

料理において、最も面倒くさいことの1つが献立決めである。献立を考える手間を省くため、レコメンドエンジンを作成したい。最も簡単なものとして、レシピ集をランダムに開いて決定する方法が思い浮かぶが、完全にランダムに決定してしまうと、同じものばかり出てしまう可能性が生じる。レシピ集の料理の種類の割合によって出てくるものに偏りが出るのだ。同じものばかりでは飽きてしまうし、栄養のバランスも崩れてしまう。これを避けるために、レシピをクラスタリングして、1週間分の献立を、クラスタが被らないようにしてランダムにレコメンドする方法が考えられる。以降、このようなレコメンドエンジンを作成する。

【METHODS】

f:id:moratoriamuo271:20190305004151p:plain

このような手順でRで作成する。

【RESULTS】

材料確保(スクレイピングする)

使用するライブラリと乱数の種。

library(tidyverse)
library(stringr)
library(rvest)
library(RMeCab)
set.seed(20190302)

クックパッドのカテゴリのリストが
https://cookpad.com/category/list にある。「今日のご飯・おかず」、「お菓子」、「パン」、「離乳食」、「その他」のカテゴリから、「今日のご飯・おかず」を選択する。13214ページあって、レシピ141355品が掲載されている(この件数は日々変動しているので注意)。

14万件全てを取ってくるのは大変なので、50ページ分だけランダムに取ってくることにする。

url <- "https://cookpad.com/category/177?page="
allrepnum <- 1:13214
repset <- sample(allrepnum, 50, replace = FALSE)

ページからレシピの番号(https://cookpad.com/recipe/の後に続く数字)を入手する関数を作成。

fget_recipenumlist <- function(url,repset){
  rec <- vector("list", length(repset))
  for(i in 1:length(repset)){
    urlfull <- str_c(url, repset[i] %>% as.character())
    rec[[i]] <- read_html(urlfull) %>% html_nodes(css = "a") %>% 
      html_attr("href") %>% str_subset("/recipe/(\\d\\d\\d\\d)") 
  }
  return(rec)
}

関数を適用する。重複して取られてしまうケースがあるので重複削除。

reclist <- fget_recipenumlist(url, repset)
reclist <- reclist %>% unlist() %>% unique()    #重複を消す

入手したレシピの番号からレシピの中身を入手する関数を作成。ごり押し気味。

fget_cookpads <- function(reclist){
  rec <- vector("list", length(reclist))
  for(i in 1:length(reclist)){
    urlfull <- str_c("https://cookpad.com",reclist[i])
    temp_text  <- read_html(urlfull) %>% html_nodes(css = "p") %>%html_text()
    loc_start <- temp_text %>% str_which("\nメンバー検索") + 1
    loc_end <- temp_text %>% str_which("(\\d\\d)/(\\d\\d)/(\\d\\d)") %>% as.list()
    if(length(loc_end)==0){
      loc_end <- temp_text %>% str_which("お困りの方はこちら") %>% as.list()
    }
    loc_end <- loc_end[[1]] - 1
    rec[[i]] <- temp_text[loc_start:loc_end]
    if(i%%100==0)print(i)    #経過状況を見るため100個おきにプリント
    Sys.sleep(1)
  }
  return(rec)
}

関数を適用する。改行を消すのと、同じレシピは一つの文書にまとめる。

cookpads <- fget_cookpads(reclist)
#改行の\nを消して各レシピを一つの文書にまとめる
cookpads <- purrr::map(cookpads, str_remove_all,"\n") %>% purrr::map(str_c, collapse="")

入手したレシピを各レシピごとで保存する。加えて、レシピを一つの文書にまとめて保存する。

#レシピの番号
reclistnum <- str_extract(reclist, "(\\d){4,}")

#レシピの保存(各レシピ)
for(i in 1:length(cookpads)){
  filename <- str_c("docs_nowrecipe/",reclistnum[i] %>% as.character()) %>% str_c(".txt")
  write(cookpads[[i]],filename)
}

#全レシピ連結で保存
allcookpads <- cookpads %>% unlist() %>% str_c(collapse = "")
write(allcookpads, "allnowdocs.txt")

これにより、500件のレシピが保存できた。

材料確認(ワードクラウドで遊んでみる)

library(tidyverse)
library(stringr)
library(RMeCab)
library(tm)
library(topicmodels)

どんな単語があるかを確認。自立語(動詞や形容詞)で見るケースと名詞で見るケース。

all_freq <- RMeCabFreq("allnowdocs.txt")

## file = allnowdocs.txt 
## length = 4110

all_freq %>% filter(Info2=="自立") %>% arrange(-Freq) %>% head(20)

##          Term  Info1 Info2 Freq
## 1        する   動詞  自立 1366
## 2      入れる   動詞  自立  897
## 3        切る   動詞  自立  412
## 4      加える   動詞  自立  332
## 5      炒める   動詞  自立  325
## 6      混ぜる   動詞  自立  285
## 7        なる   動詞  自立  193
## 8      かける   動詞  自立  174
## 9  出来上がる   動詞  自立  171
## 10       焼く   動詞  自立  167
## 11     茹でる   動詞  自立  153
## 12     食べる   動詞  自立  138
## 13       熱す   動詞  自立  117
## 14       煮る   動詞  自立  116
## 15       軽い 形容詞  自立  113
## 16     大きい 形容詞  自立  107
## 17       作る   動詞  自立   98
## 18       取る   動詞  自立   87
## 19       盛る   動詞  自立   81
## 20     つける   動詞  自立   80

all_freq %>% filter(Info1=="名詞"&Info2!="数"&Info2!="接尾") %>% arrange(-Freq) %>% head(20)

##          Term Info1    Info2 Freq
## 1  フライパン  名詞     一般  307
## 2          塩  名詞     一般  272
## 3          火  名詞     一般  254
## 4          水  名詞     一般  241
## 5          油  名詞     一般  182
## 6          ♪  名詞 サ変接続  178
## 7          鍋  名詞     一般  163
## 8          肉  名詞     一般  160
## 9          卵  名詞     一般  136
## 10          +  名詞 サ変接続  131
## 11          U  名詞     一般  130
## 12     玉ねぎ  名詞     一般  129
## 13       よう  名詞   非自立  129
## 14         皮  名詞     一般  121
## 15     レシピ  名詞     一般  117
## 16         味  名詞     一般  117
## 17       調味  名詞 サ変接続  114
## 18       材料  名詞     一般  113
## 19         皿  名詞     一般  112
## 20       好み  名詞     一般  106

名詞と自立語でワードクラウドを作ってみる。(警告が現れるが、楽しく可視化したいだけなので無視している。)

set.seed(271)
corpus <- docDF("alldocs.txt", type = 1)

## file_name =  ./alldocs.txt opened
## number of extracted terms = 1166
## now making a data frame. wait a while!

corpus <- corpus[81:nrow(corpus),]    #記号とか余計なものを消した
options(warn=-1)    #ワードクラウドの警告が邪魔なので消した
corpus1 <- corpus %>% filter(POS1 == "名詞"&POS2=="一般"| POS2 == "自立") 
wordcloud::wordcloud(corpus1$TERM, corpus1$alldocs.txt, min.freq= 5, scale=c(15,0.5),
                     family ="JP1", random.color=TRUE, color = rainbow(5))

options(warn=0)

名詞でワードクラウドを作ってみる。

options(warn=-1)
corpus2 <- corpus %>% filter(POS1 == "名詞"&POS2=="一般")
wordcloud::wordcloud(corpus2$TERM, corpus2$alldocs.txt, min.freq= 5, scale=c(15,0.5),
                     family ="JP1", random.color=TRUE, color = rainbow(5))

options(warn=0)

調理(トピックモデル)

トピックモデルの1つのLDA(Latent Dirichlet Allocation)を用いてクラスタリングを行う。

名詞と動詞に絞って、文書ターム行列を作成。記号等も削除している。削除の仕方はごり押し気味。

dir_recipe <- "docs_nowrecipe"
DTM <- docDF(dir_recipe, type = 1)
DTM <- DTM[512:4106,]

LDAを適用するために文書ターム行列の形に整形する。

DTM_nouns_verbs <- DTM %>% filter( (POS1 == "名詞"&POS2 == "一般") | POS2 == "動詞" )%>% 
  select(-c(POS1,POS2)) %>% 
  data.frame(row.names = 1) %>% t() %>% 
  as.DocumentTermMatrix(weighting = weightTf)

後でperplexity計算するため８：２でtrainとtestに分割する。

#500*1720の行列
DTM_nouns_verbs_train <- DTM_nouns_verbs[1:400,]
DTM_nouns_verbs_test <- DTM_nouns_verbs[401:500,]

モデル選択(トピック数の決定)の方法として

パープレキシティ perplexityによる評価負の対数尤度から計算される値。testデータを使用。低い方が良いモデル。
{ldatuning}パッケージの使用４つの論文で提案された指標で評価する。
変分下限でモデル評価変分ベイズを使っているならば評価に使える。
ディリクレ過程でトピック数もモデルに組み込む階層ディリクレ過程を用いるとトピック数の推定が可能。勉強不足のため、これについてはまだよく分かっていない。pythonのgenismというものを使うとできるかもしれない。以下のブログが参考になるかもしれない。 https://qiita.com/yamano357/items/90863cf15326ebd19231

以下では、{ldatuning}パッケージで、だいたいのあたりをつけて、その中からperplexityで評価して、トピック数の選択を行う。
(トピック数のベストな設定方法は結局のところ分かっていないので、もう少し調べていきたいところ。混合ユニグラムモデルまでは過去にシミュレーションデータが作れているので、LDAのシミュレーションデータを作って各指標をチェックする記事をそのうち書きたいと思っている。)

ここでは、{ldatuning}のパッケージでトピック数を2から97のトピック数を5個刻みにして評価する。

result <- ldatuning::FindTopicsNumber(
  DTM_nouns_verbs_train,
  topics = seq(from = 2, to = 97, by = 5),
  metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
  method = "Gibbs",
  control = list(seed = 777),
  mc.cores = 4L,
  verbose = TRUE
)

## fit models... done.
## calculate metrics:
##   Griffiths2004... done.
##   CaoJuan2009... done.
##   Arun2010... done.
##   Deveaud2014... done.

ldatuning::FindTopicsNumber_plot(values = result)

これにより、12~27あたりが良いだろうと見当がつくので、12,17,22,27のトピック数でperplexityを評価する。

result_tp12 <- LDA(DTM_nouns_verbs_train,12,method = "Gibbs")
result_tp17 <- LDA(DTM_nouns_verbs_train,17,method = "Gibbs")
result_tp22 <- LDA(DTM_nouns_verbs_train,22,method = "Gibbs")
result_tp27 <- LDA(DTM_nouns_verbs_train,27,method = "Gibbs")

perplexity(result_tp12, DTM_nouns_verbs_test)

## [1] 488.4454

perplexity(result_tp17, DTM_nouns_verbs_test)

## [1] 474.552

perplexity(result_tp22, DTM_nouns_verbs_test)

## [1] 471.9647

perplexity(result_tp27, DTM_nouns_verbs_test)

## [1] 473.9953

以上のldatuningとperpleixtyからトピック数22に決定。

各トピックの頻出単語を確認

terms(result_tp22,5)

##      Topic 1      Topic 2 Topic 3    Topic 4    Topic 5  Topic 6   
## [1,] "水"         "皮"    "チーズ"   "塩"       "レンジ" "火"      
## [2,] "量"         "大根"  "牛乳"     "コショウ" "耐熱"   "ベーコン"
## [3,] "ご飯"       "写真"  "ソース"   "中火"     "皿"     "好み"    
## [4,] "アク"       "作者"  "バター"   "上"       "ラップ" "とろみ"  
## [5,] "マヨネーズ" "味"    "コンソメ" "皿"       "容器"   "小麦粉"  
##      Topic 7 Topic 8 Topic 9 Topic 10 Topic 11 Topic 12     Topic 13  
## [1,] "部分"  "肉"    "ネギ"  "玉ねぎ" "材料"   "鍋"         "油"      
## [2,] "砂"    "鶏"    "生姜"  "パスタ" "器"     "火"         "こしょう"
## [3,] "肝"    "むね"  "煮汁"  "トマト" "鶏肉"   "蓋"         "火"      
## [4,] "醤油"  "塩"    "鯛"    "オイル" "油"     "弱火"       "豚"      
## [5,] "黒"    "衣"    "酒"    "ソース" "一口"   "じゃがいも" "強火"    
##      Topic 14     Topic 15   Topic 16     Topic 17   Topic 18  
## [1,] "フライパン" "塩"       "フライパン" "豆腐"     "キャベツ"
## [2,] "卵"         "きゅうり" "ボウル"     "水気"     "豚肉"    
## [3,] "大さじ"     "ボール"   "サラダ油"   "皿"       "ごま油"  
## [4,] "油"         "胡椒"     "両面"       "水分"     "好み"    
## [5,] "白"         "玉ねぎ"   "玉ねぎ"     "キッチン" "火"      
##      Topic 19       Topic 20 Topic 21 Topic 22
## [1,] "レシピ"       "冷蔵庫" "野菜"   "白菜"  
## [2,] "ドレッシング" "酢"     "水"     "ご飯"  
## [3,] "ねぎ"         "大葉"   "味"     "だし"  
## [4,] "中華"         "好み"   "最後"   "幅"    
## [5,] "サラダ"       "水気"   "鍋"     "葉"

解釈しやすそうなものを４つ取り上げた。

terms(result_tp22,5)[,c(3,8,15,18)] %>% as.data.frame()

##    Topic 3 Topic 8 Topic 15 Topic 18
## 1   チーズ      肉       塩 キャベツ
## 2     牛乳      鶏 きゅうり     豚肉
## 3   ソース    むね   ボール   ごま油
## 4   バター      塩     胡椒     好み
## 5 コンソメ      衣   玉ねぎ       火

Topic 3 グラタン, シチュー, スープ
Topic 8 唐揚げなど鶏肉料理
Topic 15 サラダ
Topic 18 野菜炒め

といったところだろうか。

文書ごとのトピック分類を行う。推定されたトピック分布の最大の値をとるトピックをその文書のトピックとして分類することにする。

result_tp22_cdoc <- result_tp22 %>% tidytext::tidy(matrix = "gamma") %>% as.data.frame()
result_tp22_cdoc$document <- result_tp22_cdoc$document %>% str_remove_all("X")
doctop <- result_tp22_cdoc %>% group_by(document) %>% filter(gamma==max(gamma)) %>% ungroup() %>% select(-gamma)
head(doctop)

## # A tibble: 6 x 2
##   document    topic
##   <chr>       <int>
## 1 109612.txt      1
## 2 1289543.txt     1
## 3 1307357.txt     1
## 4 139698.txt      1
## 5 1426704.txt     1
## 6 1457975.txt     1

400になると思ったら、もっとあった。重複した文書があるのは、おそらくgammaの最大値が一緒のトピックがあったのだろう。ここでは、重複も含めてしまうことにする。

これを保存する。

write_csv(doctop, "doctop.csv")
doctop <- read_csv("doctop.csv")

ここまでやったものを保存しておけば、いちいち上の面倒くさい計算を回さず、レコメンドしたいときに読み込んで使える。

完成(レコメンド)

#一週間分の料理(7食分)をレコメンド
frecommend7url <- function(doctop){
  seventopics <- sample(x = unique(doctop$topic), size = 7, replace = FALSE)
  rec7 <- character(7)
  for(i in 1:7){
    doctopfil <- doctop %>% filter(topic==seventopics[i])
    rec7[i] <- sample(x = doctopfil$document, size = 1)
  }
  rec7 <- rec7 %>% str_remove(".txt") %>% str_c("https://cookpad.com/recipe/", .)
  return(rec7)
}

frecommend7url(doctop)

## [1] "https://cookpad.com/recipe/3169287"
## [2] "https://cookpad.com/recipe/1370545"
## [3] "https://cookpad.com/recipe/2733198"
## [4] "https://cookpad.com/recipe/2866455"
## [5] "https://cookpad.com/recipe/2721802"
## [6] "https://cookpad.com/recipe/2430458"
## [7] "https://cookpad.com/recipe/1120158"

トピックの異なるレシピのurlが7つ提案されるレコメンドエンジンが完成された。提案されたレシピを実際に見てみると、トピックが違うレシピが提案されていることが確認される。

【CONCLUSIONS】

LDAを用いてクックパッドのレシピをトピックで分類して、トピックが異なるレシピを7つ提案するレコメンドエンジンが作成された。提案されたレシピを実際に見てみると、トピックが違うレシピが提案されていることが確認された。
このレコメンドエンジンは、とりあえず、トピック別にレシピが提案されるが、レコメンドエンジンとしての性能があまり良いものとは言えないだろう。要件として、冷蔵庫の中身とか手持ちの材料の賞味期限とか季節の食べ物とか必要な分量とかの情報を組み込んだレコメンドが望ましい。そんな性能のよいレコメンドエンジンが作れているなら、クックパッドにとっくに売り込んでいるという話である。

【REFERENCES】

岩田『トピックモデル』
佐藤『トピックモデルによる統計的潜在意味解析』
松浦『StanとRでベイズ統計モデリング』
小林『Rによるやさしいテキストマイニング[機械学習編]』
『Select number of topics for LDA model』
https://cran.r-project.org/web/packages/ldatuning/vignettes/topics.html
『蒙古タンメン中本コーパスに対してのLDAの適用とトピック数の探索』
http://kamonohashiperry.com/archives/1619
『[R] トピックモデル(LDA)を用いた大量文書の教師なし分類』
https://qiita.com/YM_DSKR/items/017a5dddeb56fcdf1054

霞と側杖を食らう

ほしいものです。なにかいただけるとしあわせです。[https://www.amazon.jp/hz/wishlist/ls/2EIEFTV4IKSIJ?ref_=wl_share]