レコメンドつれづれ 1-2 Rによるユーザベース協調フィルタリングの実装例

ubcf_for_blog.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番ユーザ