『集合知プログラミング』をR言語で書く
- 作者: Toby Segaran,當山仁健,鴨澤眞夫
- 出版社/メーカー: オライリージャパン
- 発売日: 2008/07/25
- メディア: 大型本
- 購入: 91人 クリック: 2,220回
- この商品を含むブログ (277件) を見る
2.3.1 ユークリッド距離によるスコア
距離はdist()を使えば算出できる
# 類似性スコアの算出（ユークリッド平方距離に基づく） (critics.dist.euc <- 1/(1+dist(t(critics))^2)) # 出力 # Lisa.Rose Gene.Seymour Michael.Phillips Claudia.Puig Mick.LaSalle Jack.Matthews # Gene.Seymour 0.14814815 # Michael.Phillips 0.34782609 0.15094340 # Claudia.Puig 0.25000000 0.11363636 0.40000000 # Mick.LaSalle 0.33333333 0.12903226 0.21052632 0.14925373 # Jack.Matthews 0.18181818 0.76923077 0.12903226 0.12903226 0.11764706 # Toby 0.12500000 0.05714286 0.11764706 0.13333333 0.18181818 0.06250000
ついでにマンハッタン距離による類似性スコアも算出しておく。
# 類似性スコアの算出（マンハッタン距離に基づく） (critics.dist.man <- 1/(1+dist(t(critics), method="manhattan"))) # 出力 # Lisa.Rose Gene.Seymour Michael.Phillips Claudia.Puig Mick.LaSalle Jack.Matthews # Gene.Seymour 0.1818182 # Michael.Phillips 0.3076923 0.1600000 # Claudia.Puig 0.2941176 0.1428571 0.2500000 # Mick.LaSalle 0.2500000 0.1818182 0.1818182 0.1562500 # Jack.Matthews 0.1923077 0.6250000 0.1428571 0.1428571 0.1923077 # Toby 0.1428571 0.1000000 0.1428571 0.1666667 0.1666667 0.1111111
キャンベラ距離による類似性スコアも。
# 類似性スコアの算出（キャンベラ距離に基づく） (critics.dist.can <- 1/(1+dist(t(critics), method="canberra"))) # 出力 # Lisa.Rose Gene.Seymour Michael.Phillips Claudia.Puig Mick.LaSalle Jack.Matthews # Gene.Seymour 0.5658094 # Michael.Phillips 0.7520661 0.5777876 # Claudia.Puig 0.7575758 0.5067568 0.7118317 # Mick.LaSalle 0.6469938 0.5772835 0.5951249 0.5362615 # Jack.Matthews 0.6246660 0.9259259 0.5465553 0.5504587 0.6145251 # Toby 0.4463337 0.3870968 0.5555556 0.4745763 0.4830853 0.4080000
地図を貼り付ける方法がわからん。
マンハッタンの地図 いわゆる碁盤の目というやつ。
キャンベラの地図 ちょっとわかりにくいですが、放射円状ということですね。
2.3.2 ピアソン相関によるスコア
相関係数はcor()で。
# 相関係数の算出（ピアソンの積率相関係数） (critics.cor.pea <- cor(critics, use="pairwise.complete.obs")) # 出力 # Lisa.Rose Gene.Seymour Michael.Phillips Claudia.Puig Mick.LaSalle Jack.Matthews Toby # Lisa.Rose 1.0000000 0.3960590 0.4045199 0.56694671 0.5940885 0.74701788 0.9912407 # Gene.Seymour 0.3960590 1.0000000 0.2045983 0.31497039 0.4117647 0.96379568 0.3812464 # Michael.Phillips 0.4045199 0.2045983 1.0000000 1.00000000 -0.2581989 0.13483997 -1.0000000 # Claudia.Puig 0.5669467 0.3149704 1.0000000 1.00000000 0.5669467 0.02857143 0.8934051 # Mick.LaSalle 0.5940885 0.4117647 -0.2581989 0.56694671 1.0000000 0.21128856 0.9244735 # Jack.Matthews 0.7470179 0.9637957 0.1348400 0.02857143 0.2112886 1.00000000 0.6628490 # Toby 0.9912407 0.3812464 -1.0000000 0.89340515 0.9244735 0.66284898 1.0000000
スピアマンの順位相関係数も。
# 相関係数の算出（スピアマンの順位相関係数） (critics.cor.spe <- cor(critics, use="pairwise.complete.obs", method="spearman")) # 出力 # Lisa.Rose Gene.Seymour Michael.Phillips Claudia.Puig Mick.LaSalle Jack.Matthews Toby # Lisa.Rose 1.0000000 0.4308202 0.3162278 0.5270463 0.5809475 0.7299964 0.8660254 # Gene.Seymour 0.4308202 1.0000000 0.1054093 0.1025978 0.3654940 0.9733285 0.0000000 # Michael.Phillips 0.3162278 0.1054093 1.0000000 1.0000000 -0.2581989 0.1054093 -1.0000000 # Claudia.Puig 0.5270463 0.1025978 1.0000000 1.0000000 0.6324555 -0.2000000 0.5000000 # Mick.LaSalle 0.5809475 0.3654940 -0.2581989 0.6324555 1.0000000 0.2294157 1.0000000 # Jack.Matthews 0.7299964 0.9733285 0.1054093 -0.2000000 0.2294157 1.0000000 0.5000000 # Toby 0.8660254 0.0000000 -1.0000000 0.5000000 1.0000000 0.5000000 1.0000000
ケンドールの順位相関係数も。
# 相関係数の算出（ケンドールの順位相関係数） (critics.cor.ken <- cor(critics, use="pairwise.complete.obs", method="kendall")) # 出力 # Lisa.Rose Gene.Seymour Michael.Phillips Claudia.Puig Mick.LaSalle Jack.Matthews Toby # Lisa.Rose 1.0000000 0.3202563 0.1825742 0.4472136 0.5222330 0.5892557 0.8164966 # Gene.Seymour 0.3202563 1.0000000 0.1825742 0.1054093 0.3344968 0.9428090 0.0000000 # Michael.Phillips 0.1825742 0.1825742 1.0000000 1.0000000 -0.2357023 0.1825742 -1.0000000 # Claudia.Puig 0.4472136 0.1054093 1.0000000 1.0000000 0.4472136 0.0000000 0.3333333 # Mick.LaSalle 0.5222330 0.3344968 -0.2357023 0.4472136 1.0000000 0.1259882 1.0000000 # Jack.Matthews 0.5892557 0.9428090 0.1825742 0.0000000 0.1259882 1.0000000 0.3333333 # Toby 0.8164966 0.0000000 -1.0000000 0.3333333 1.0000000 0.3333333 1.0000000
2.3.4 評者をランキングする
ここではtopMatches関数を移植するわけですが、その前に13ページの下記の記述について疑問を挙げておきます。
ピアソン相関係数を利用する上で興味深いことの一つとして、よい成績の大盤振る舞いによる誤差を修正してくれるという点が挙げられる。
それは全く正しいんだけれど、文脈上、距離を使った場合はそうでないように読めてしまうのに違和感がある。
評者ごとに評点の中心化を行えば、距離を使っても個人差は補正できるはず。
なので、topMatches関数に評者ごとに評点の中心化を行ってから算出した距離も利用できるようにオプションを付けてみました。
# 指定した評者に好みの似た順のリストを出す関数。 # prefs 行が作品、列が評者のマトリクス # person 対象者 # n 出力する上位からの件数。既定値は３。 # similarity 類似性の指標。既定値はピアソンの積率相関係数。 # "euclidean" ユークリッド平方距離 # "euclidean.center" 評者ごとに中心化したユークリッド平方距離 # "manhattan" マンハッタン距離 # "manhattan.center" 評者ごとに中心化したマンハッタン距離 # "pearson" ピアソンの積率相関係数 # "spearman" スピアマンの順位相関係数 # "kendall" ケンドールの順位相関係数 topMatches <- function(prefs, person, n=3, similarity="pearson"){ switch(similarity, "euclidean" = sim.index <- as.matrix(1/(1+dist(t(prefs))^2)), "euclidean.center" = sim.index <- as.matrix(1/(1+dist(t(scale(prefs, scale=FALSE)))^2)), "manhattan" = sim.index <- as.matrix(1/(1+dist(t(prefs), method="manhattan"))), "manhattan.center" = sim.index <- as.matrix(1/(1+dist(t(scale(prefs, scale=FALSE)), method="manhattan"))), "pearson" = sim.index <- cor(prefs, use="pairwise.complete.obs"), "spearman" = sim.index <- cor(prefs, use="pairwise.complete.obs", method="spearman"), "kendall" = sim.index <- cor(prefs, use="pairwise.complete.obs", method="kendall") ) diag(sim.index) <- 0 head(sort(sim.index[,person], decreasing=TRUE),n) }
使い方。ピアソンの積率相関係数に基づいてTobyと好みの似た人を３位まで出力する場合。
topMatches(critics, "Toby") # 出力 # Lisa.Rose Mick.LaSalle Claudia.Puig # 0.9912407 0.9244735 0.8934051
評者ごとに中心化したマンハッタン距離に基づいてTobyと好みの似た人を５位まで出力する場合。
topMatches(critics, "Toby", 5, "manhattan.center") # 出力 # Mick.LaSalle Lisa.Rose Claudia.Puig Michael.Phillips Jack.Matthews # 0.1875000 0.1500000 0.1500000 0.1333333 0.1260504
2.4 アイテムを推薦する
今度はgetRecommendations関数を移植する。
ただし、id:shrkw:20081113:cloud_on_pci_1 でも
最後にそのアイテムを評価しているユーザーの類似度の計で除算するというのが理解できない。
と指摘されているように、評点の合計で割るというのは違和感があるので、ここでは平均値を使うことにする。
そのためサンプルコードとは結果が異なっている。
この評点の合計で割るというのは本文中では「正規化」と表現されているので、もしかしたら前述した個人差を補正するような意図で行われているのかも知れない。
だとしても謎であるが。
# 指定した評者に次に見るべき作品のリストを出す関数。 # prefs 行が作品、列が評者のマトリクス # person 対象者 # similarity 類似性の指標。既定値はピアソンの積率相関係数。 # "euclidean" ユークリッド平方距離 # "euclidean.center" 評者ごとに中心化したユークリッド平方距離 # "manhattan" マンハッタン距離 # "manhattan.center" 評者ごとに中心化したマンハッタン距離 # "pearson" ピアソンの積率相関係数 # "spearman" スピアマンの順位相関係数 # "kendall" ケンドールの順位相関係数 getRecommendations <- function(prefs, person, similarity="pearson"){ switch(similarity, "euclidean" = sim.index <- as.matrix(1/(1+dist(t(prefs))^2)), "euclidean.center" = sim.index <- as.matrix(1/(1+dist(t(scale(prefs, scale=FALSE)))^2)), "manhattan" = sim.index <- as.matrix(1/(1+dist(t(prefs), method="manhattan"))), "manhattan.center" = sim.index <- as.matrix(1/(1+dist(t(scale(prefs, scale=FALSE)), method="manhattan"))), "pearson" = sim.index <- cor(prefs, use="pairwise.complete.obs"), "spearman" = sim.index <- cor(prefs, use="pairwise.complete.obs", method="spearman"), "kendall" = sim.index <- cor(prefs, use="pairwise.complete.obs", method="kendall") ) diag(sim.index) <- 0 # ここから下はもうちょっとキレイに書けそうな気がするけど…… x1 <- (sim.index[,colnames(sim.index)==person]) x2 <- x1[names(x1)!=person] x3 <- x2[x2>0] y1 <- prefs[,colnames(prefs)!=person] y2 <- y1[,x2>0] z1 <- apply(as.matrix(x3*y2), 1, mean, na.rm=TRUE) z2 <- prefs[,colnames(prefs)==person] sort(z1[is.na(z2)], decreasing=TRUE) }
使い方。データと評者と類似性の指標を指定するだけ。
getRecommendations(critics, "Toby", "spearman") # 出力 # Lady.in.the.Water Just.My.Luck The.Night.Listener # 2.587713 2.532692 1.687500
2.5 似ている製品
今度は amazon の「この商品を買った人はこんな商品も買っています」みたいな話ですね。
topMatches関数とgetRecommendations関数を再利用します。
要するに与えるデータの行と列を転置する（入れ替える）だけ。
製品から製品を推薦。
topMatches(t(critics), "Superman.Returns") # 出力 # You.Me.and.Dupree Lady.in.the.Water Snakes.on.a.Plane # 0.6579517 0.4879500 0.1118034
製品から人を推薦。前述したように評点の合計で割るのではなくて算術平均を使っているため、サンプルコードとは結果が異なります。
getRecommendations(t(critics), "Just.My.Luck") # Michael.Phillips Jack.Matthews # 2.222222 1.666667
さて、ここまではサクサク進んできましたが、次からはAPIを通じてデータを得るという作業が入ってくるので、ちょっと研究してからじゃないと進めそうに無いです。
