Skip to content

Instantly share code, notes, and snippets.

@messefor
Last active February 27, 2020 09:06
Show Gist options
  • Save messefor/e7a2555c84653b5fdc4ad40c85195b48 to your computer and use it in GitHub Desktop.
Save messefor/e7a2555c84653b5fdc4ad40c85195b48 to your computer and use it in GitHub Desktop.
レコメンドつれづれ 1-2 Rによるユーザベース協調フィルタリングの実装例
#----------------------------------------------------------
# Rによる協調フィルタリングの実装例
#
# Brainpad技術ブログ:レコメンドつれづれ 1-2付属コード
#
#----------------------------------------------------------
library(recommenderlab)
#------------------------------------------
# 関数定義
#------------------------------------------
# コサイン類似度を算出する関数
simil.cosine <- function(X, Y=NULL) {
if (is.null(Y)) Y <- X
nume <- X %*% t(Y)
deno <- sqrt(diag(X %*% t(X)) %*%
t(diag(Y %*% t(Y))))
return(nume / deno)
}
# 評価値を中心化する関数
centering.by.user <- function(X) {
center <- rowMeans(X, na.rm=TRUE)
X.norm <- X - center
return(list(data=X.norm, center=center))
}
# 類似度の高い上位kユーザを取得(knn)する関数
get.knn <- function(simil, k=25) {
knn <- do.call(rbind,
sapply(rownames(simil),
(function(x)(head(names(simil[x,])[order(simil[x,], decreasing=TRUE)],n=k))),
simplify=FALSE))
colnames(knn) <- 1:k
return(knn)
}
# 加重平均を算出する関数(行列版)
mean.weighted <- function(target.id) {
weighted.rating <- simil.mtx[target.id, nn[target.id,], drop=TRUE] *
train.cen[nn[target.id,], ]
mean.rating <- colSums(weighted.rating) /
sum(simil.mtx[target.id, nn[target.id,]])
return(mean.rating)
}
# 評価順に作品を並べ替える
sort.list.by.rating <- function(x) {
pred.not.rated <- pred.ratings[[x]][is.na(target.mtx[x,])]
return(head(sort(pred.not.rated, decreasing=TRUE)))
}
#------------------------------------------
# 実行部分
#------------------------------------------
# データセットの読み込み
data(MovieLense)
# レコメンド対象ユーザの指定
target.id <- c('101', '102')
# 学習用ユーザと推定対象ユーザの評価値の格納
train.mtx <- as(MovieLense[1:100], 'matrix')
target.mtx <- as(MovieLense[target.id], 'matrix')
# 評価値の中心化
train.cen.obj <- centering.by.user(train.mtx)
target.cen.obj <- centering.by.user(target.mtx)
# 中心化した評価の抽出
train.cen <- train.cen.obj$data
target.cen <- target.cen.obj$data
# NAを0で置換
train.cen[is.na(train.cen)] <- .0
target.cen[is.na(target.cen)] <- .0
# レコメンド対象ユーザと他のユーザのコサイン類似度を計算
simil.mtx <- simil.cosine(target.cen, train.cen)
# 類似度の近い上位25人のユーザ番号を抽出
nn <- get.knn(simil.mtx, k=25)
# 加重平均した評価値の算出し、平均値で足し戻す
weighted.mean.ratings <- sapply(target.id, mean.weighted, simplify=FALSE)
pred.ratings <- sapply(names(weighted.mean.ratings),
(function(x){target.cen.obj$center[x] + weighted.mean.ratings[[x]]}),
simplify=FALSE)
# 推薦リストの作成
# ユーザの未評価の作品に絞って、評価順に作品を並べ替える
rec.list <-
sapply(rownames(simil.mtx), sort.list.by.rating, simplify=FALSE)
# 推薦リストのTOP10を表示
head(pred.ratings[['101']], n=10) # 101番ユーザ
head(pred.ratings[['102']], n=10) # 102番ユーザ
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment