10.1、协同过滤实例

协同过滤实例

junjun

2016年2月11日

recommenderlab包提供了一个可以用评分数据和0-1数据来发展和测试推荐算法的框架。它提供了几种基础算法，并可利用注册机制允许用户使用自己的算法 recommender包的数据类型采用S4类构造，使用抽象的raringMatrix为评分数据提供接口。raringMatrix采用了很多类似矩阵对象的操作，如dim(),dimnames(),rowCounts(),colMeans(),rowMeans(),colSums(),rowMeans()；也增加了一些特别的操作方法，如sample()，用于从用户（即，行）中抽样，image()可以生成像素图。raringMatrix的两种具体运用是realRatingMatrix和binaryRatingMatrix,分别对应评分矩阵的不同情况。其中realRatingMatrix使用的是真实值的评分矩阵，存储在由Matrix包定义的稀疏矩阵（spare matrix）格式中；binaryRatingMatrix使用的是0-1评分矩阵，存储在由arule包定义的itemMatrix中。

为评价推荐算法的表现，recommenderlab 包提供了函数 evaluationScheme()建立评价方案，能够使用简单划分、k折交叉验证、自助法进行模型的评价。 evaluationScheme（）的主要参数：method，评估方法；train，划分为训练集的数据比例；k运行评估的折数或倍数（split的默认值为1）；given表示用来进行模型评价的items的数量。

实例、recommenderlab包实现电影评分预测

电影数据的准备和清理：数据来源http://grouplens.org/datasets/movielens/ 本文分析的数据是MovieLens 100k，总共有100,000个评分，来自1000位用户对1700部电影的评价。

#1、加载数据：数据的格式，第一列是 user id，第二列是 item id，第三列是 rating，第四列是时间戳，时间戳这里用不到，可去掉
movie <- read.table("F:\\R\\Rworkspace\\机器学习实践课\\电影评价数据\\ml-100k/u.data", sep="\t", header=F, stringsAsFactors=T)
str(movie)

## 'data.frame':    100000 obs. of  4 variables:
##  $ V1: int  196 186 22 244 166 298 115 253 305 6 ...
##  $ V2: int  242 302 377 51 346 474 265 465 451 86 ...
##  $ V3: int  3 3 1 2 1 4 2 5 3 3 ...
##  $ V4: int  881250949 891717742 878887116 880606923 886397596 884182806 881171488 891628467 886324817 883603013 ...

summary(movie)

##        V1              V2               V3             V4           
##  Min.   :  1.0   Min.   :   1.0   Min.   :1.00   Min.   :874724710  
##  1st Qu.:254.0   1st Qu.: 175.0   1st Qu.:3.00   1st Qu.:879448710  
##  Median :447.0   Median : 322.0   Median :4.00   Median :882826944  
##  Mean   :462.5   Mean   : 425.5   Mean   :3.53   Mean   :883528851  
##  3rd Qu.:682.0   3rd Qu.: 631.0   3rd Qu.:4.00   3rd Qu.:888259984  
##  Max.   :943.0   Max.   :1682.0   Max.   :5.00   Max.   :893286638

#总结：共有100,000个评分，来自1000位用户对1700部电影的评价；全部为数字类型，其中V4为时间戳，可以删除。

#查看数据:查看电影评分等级分布情况,简单看下 rating 的分布情况
prop.table(table(movie[, 3]))

## 
##       1       2       3       4       5 
## 0.06110 0.11370 0.27145 0.34174 0.21201

summary(movie[, 3])

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    3.00    4.00    3.53    4.00    5.00

# 中位数不能说明问题，因为评分数据不是排列好的

#2、数据清洗
#1）将第四列时间戳去掉
movie <- movie[, 1:3]

#2)使用??reshape??包的??cast()??进行转换，转换后数据格式为，行为用户（user），列为项目（item）
library(reshape)
movie <- cast(movie, V1~V2, value = "V3")
# 注意：此时共有三个属性V1、V2和V3，转换后的缺失值默认为NA

#到此，把数据整理成 ratingMatrix，接下来利用 recommenderlab 处理数据。
dim(movie)

## [1]  943 1683

movie[1:3, 1:6]

##   V1  1  2  3  4  5
## 1  1  5  3  4  3  3
## 2  2  4 NA NA NA NA
## 3  3 NA NA NA NA NA

#注意：V1属性列可以不用，在转换为realRatingMatrix类型后删除此属性列。

#删除V1列
movie <- movie[, 2:1683]
dim(movie)

## [1]  943 1682

movie[1:3, 1:6]

##    1  2  3  4  5  6
## 1  5  3  4  3  3  5
## 2  4 NA NA NA NA NA
## 3 NA NA NA NA NA NA

#3、使用recommenderlab包处理数据
#1）、在用 recommenderlab 处理数据之前，需将数据转换为??realRatingMatrix??类型，这是 recommenderlab 包中专门针对 1-5 star 的一个新类，需要从??matrix??类型转换得到realRatingMatrix类型

#将cast_df和data.frame类型的movie数据转化为realRatingMatrix类型的movie数据
#①从cast_df和data.frame类型转化为data.frame类型
class(movie)

## [1] "cast_df"    "data.frame"

class(movie) <- "data.frame"
#注意：上文获得的??movie有两个类属性，其中??cast_df??是不能直接转换为??matrix??的，因此需要去掉这个类属性，只保留??data.frame

#②从data.frame类型转化为matrix类型
movie <- as.matrix(movie)

#③从matrix类型转化为realRatingMatrix类型
library(recommenderlab)

## Loading required package: Matrix

## 
## Attaching package: 'Matrix'

## The following object is masked from 'package:reshape':
## 
##     expand

## Loading required package: registry

## Loading required package: arules

## 
## Attaching package: 'arules'

## The following objects are masked from 'package:base':
## 
##     %in%, abbreviate, write

## Loading required package: proxy

## 
## Attaching package: 'proxy'

## The following object is masked from 'package:Matrix':
## 
##     as.matrix

## The following objects are masked from 'package:stats':
## 
##     as.dist, dist

## The following object is masked from 'package:base':
## 
##     as.matrix

movie <- as(movie, "realRatingMatrix")
class(movie)

## [1] "realRatingMatrix"
## attr(,"package")
## [1] "recommenderlab"

dim(movie)

## [1]  943 1682

#movie是可以用 recommenderlab 进行处理的??realRatingMatrix，943是 user 数，1682 指的是 item 数,??realRatingMatrix??可以很方便地转换为??matrix??和??list

#2）、将realRatingMatrix类型的电影数据分别转化为matrix和list类型
#①将realRatingMatrix类型转化为matrix类型
as(movie, "matrix")[1:3, 1:10]

##    1  2  3  4  5  6  7  8  9 10
## 1  5  3  4  3  3  5  4  1  5  3
## 2  4 NA NA NA NA NA NA NA NA  2
## 3 NA NA NA NA NA NA NA NA NA NA

#②将realRatingMatrix类型转化为list类型
as(movie, "list")[[1]][1:10]

##  1  2  3  4  5  6  7  8  9 10 
##  5  3  4  3  3  5  4  1  5  3

#4、了解数据情况
#1）可视化了解数据集的情况
image(movie)

image(movie[1:100, 1:100])

#2)获取评分数据
ratings_movie <- data.frame(ratings=getRatings(movie))
summary(ratings_movie)

##     ratings    
##  Min.   :1.00  
##  1st Qu.:3.00  
##  Median :4.00  
##  Mean   :3.53  
##  3rd Qu.:4.00  
##  Max.   :5.00

library(ggplot2)
ggplot(ratings_movie, aes(x=ratings)) + geom_histogram(fill="beige", color="black",binwidth = 1, alpha=0.7) + xlab("rating") + ylab("count")

#标准化处理：标准化的目的是为了去除用户的评分偏差
ratings_movie1 <- data.frame(ratings=getRatings(normalize(movie, method="Z-score")))
summary(ratings_movie1$ratings)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -4.8520 -0.6470  0.1165  0.0000  0.7470  4.1460

ggplot(ratings_movie1, aes(x=ratings)) + geom_histogram(fill="beige", color="black",binwidth = 1, alpha=0.7) + xlab("rating") + ylab("count")

#3)用户的电影点评数：用户存在长尾
movie_count <- data.frame(count=rowCounts(movie))
str(movie_count)

## 'data.frame':    943 obs. of  1 variable:
##  $ count: int  272 62 54 24 175 211 403 59 22 184 ...

ggplot(movie_count, aes(x=count)) + geom_histogram(fill="beige", color="black", alpha=0.7) + xlab("NO.users") + ylab("No.movies rated")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

#4)电影的平均评分
rating_mean <- data.frame(rating=colMeans(movie))
ggplot(rating_mean, aes(x=rating)) + geom_histogram(fill="beige", color="black",alpha=0.7) + xlab("ratings") + ylab("counts of moves")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

hist(rowCounts(movie))

hist(colCounts(movie))

mean(rowMeans(movie))

## [1] 3.588191

#5、创建推荐模型
#1）给矩阵的所有列按照??itemlabels??进行列命名
colnames(movie) <- paste("M", 1:1682, sep="")
as(movie[1, 1:5], "list")

## $`1`
## M1 M2 M3 M4 M5 
##  5  3  4  3  3

#注意：在建立推荐模型之前一定要给item按照itemLabels进行命名，否则会有错误

#2)查看recommenderlab的六种推荐方法,对于realRatingMatrix有六种方法：IBCF(基于物品的推荐)、UBCF（基于用户的推荐）、SVD（矩阵因子化）、PCA（主成分分析）、 RANDOM（随机推荐）、POPULAR（基于流行度的推荐）
recommenderRegistry$get_entries(dataType="realRatingMatrix")

## $IBCF_realRatingMatrix
## Recommender method: IBCF
## Description: Recommender based on item-based collaborative filtering (real data).
## Parameters:
##    k method normalize normalize_sim_matrix alpha na_as_zero minRating
## 1 30 Cosine    center                FALSE   0.5      FALSE        NA
## 
## $PCA_realRatingMatrix
## Recommender method: PCA
## Description: Recommender based on PCA approximation (real data).
## Parameters:
##   categories method normalize normalize_sim_matrix alpha na_as_zero
## 1         20 Cosine    center                FALSE   0.5      FALSE
##   minRating
## 1        NA
## 
## $POPULAR_realRatingMatrix
## Recommender method: POPULAR
## Description: Recommender based on item popularity (real data).
## Parameters: None
## 
## $RANDOM_realRatingMatrix
## Recommender method: RANDOM
## Description: Produce random recommendations (real ratings).
## Parameters: None
## 
## $SVD_realRatingMatrix
## Recommender method: SVD
## Description: Recommender based on SVD approximation (real data).
## Parameters:
##   categories method normalize normalize_sim_matrix alpha treat_na
## 1         50 Cosine    center                FALSE   0.5   median
##   minRating
## 1        NA
## 
## $UBCF_realRatingMatrix
## Recommender method: UBCF
## Description: Recommender based on user-based collaborative filtering (real data).
## Parameters:
##   method nn sample normalize minRating
## 1 cosine 25  FALSE    center        NA

#3)基于IBCF的协同过滤，创建推荐模型：利用前940位用户建立推荐模型
model_movie <- Recommender(movie[1:940], method="IBCF")
model_movie

## Recommender of type 'IBCF' for 'realRatingMatrix' 
## learned using 940 users.

#6、模型建立以后，就可以用来进行预测和推荐了。对后三位用户进行推荐预测，使用predict()函数，默认是topN推荐，这里取n=5。预测后得到的一个topNList对象，可以把它转化为列表，看预测结果

#1）对item进行top-N推荐
pred <- predict(model_movie, movie[941:943], n=5)
pred

## Recommendations as 'topNList' with n = 5 for 3 users.

#查看推荐结果
as(pred, "list")

## [[1]]
## [1] "M10" "M14" "M19" "M22" "M28"
## 
## [[2]]
## [1] "M3"  "M39" "M45" "M47" "M48"
## 
## [[3]]
## [1] "M13"  "M45"  "M128" "M206" "M207"

#941、942、943三个用户的原评价列表
as(movie[941:943], "list")

## $`941`
##    M1    M7   M15  M117  M124  M147  M181  M222  M257  M258  M273  M294 
##     5     4     4     5     5     4     5     2     4     4     3     4 
##  M298  M300  M358  M408  M455  M475  M763  M919  M993 M1007 
##     5     4     2     5     4     4     3     5     4     4 
## 
## $`942`
##   M31   M50   M71   M79   M95   M97   M99  M117  M124  M131  M135  M172 
##     5     5     5     5     5     5     5     4     4     5     3     5 
##  M174  M183  M193  M197  M200  M210  M215  M216  M234  M258  M259  M261 
##     5     3     5     5     4     4     5     4     4     4     4     4 
##  M265  M269  M272  M282  M300  M303  M304  M310  M313  M315  M316  M318 
##     5     2     5     5     5     4     5     4     3     4     4     5 
##  M322  M323  M328  M347  M357  M362  M414  M423  M427  M435  M478  M479 
##     3     3     3     5     4     3     4     5     5     5     5     4 
##  M480  M484  M487  M496  M498  M500  M511  M514  M520  M528  M539  M584 
##     5     5     4     5     5     5     4     4     5     5     3     4 
##  M604  M607  M615  M659  M661  M662  M678  M689  M705  M750  M878  M879 
##     4     5     3     5     4     4     3     3     4     4     4     4 
##  M892  M945  M969 M1028 M1050 M1204 M1221 
##     3     5     4     4     5     4     4 
## 
## $`943`
##    M2    M9   M11   M12   M22   M23   M24   M27   M28   M31   M38   M41 
##     5     3     4     5     4     4     4     4     4     4     3     4 
##   M42   M50   M51   M53   M54   M55   M56   M58   M62   M64   M67   M68 
##     5     4     1     3     4     5     5     4     3     5     4     4 
##   M69   M72   M73   M76   M79   M80   M92   M94   M96   M97   M98  M100 
##     5     2     3     4     5     2     5     4     4     2     5     5 
##  M111  M117  M121  M122  M124  M127  M132  M139  M151  M161  M168  M172 
##     4     4     3     1     3     5     3     1     4     4     2     4 
##  M173  M174  M181  M182  M184  M185  M186  M187  M188  M193  M194  M195 
##     5     4     4     5     5     2     5     5     4     4     5     4 
##  M196  M200  M201  M202  M204  M205  M210  M215  M216  M217  M218  M219 
##     5     4     5     2     3     5     4     5     4     3     4     4 
##  M226  M227  M228  M229  M230  M231  M232  M233  M234  M237  M239  M274 
##     4     1     3     2     1     2     4     5     3     4     5     3 
##  M281  M282  M284  M318  M356  M367  M373  M385  M386  M391  M393  M399 
##     4     5     2     3     4     4     3     4     1     2     2     1 
##  M401  M402  M403  M405  M406  M412  M415  M419  M421  M423  M426  M427 
##     1     2     4     4     3     2     1     2     2     3     4     4 
##  M431  M443  M449  M450  M468  M470  M471  M475  M485  M508  M526  M541 
##     4     2     1     1     2     4     5     5     5     5     4     4 
##  M546  M549  M559  M566  M568  M569  M570  M576  M581  M585  M595  M609 
##     4     1     4     4     3     2     1     4     4     1     2     2 
##  M614  M625  M655  M672  M685  M717  M720  M721  M722  M724  M732  M739 
##     5     3     4     5     4     4     1     5     3     1     4     4 
##  M756  M763  M765  M785  M794  M796  M808  M816  M824  M825  M831  M840 
##     2     4     3     2     3     3     4     4     4     3     2     4 
##  M928  M941  M943 M1011 M1028 M1044 M1047 M1067 M1074 M1188 M1228 M1330 
##     5     1     5     2     2     3     2     2     4     3     3     3

#2)对item进行评分预测
pred2 <- predict(model_movie, movie[801:803], type="ratings")
pred2

## 3 x 1682 rating matrix of class 'realRatingMatrix' with 1213 ratings.

#查看三个用户对M1-6的预测评分
as(pred2, "matrix")[1:3, 1:6]

##           M1 M2 M3 M4       M5 M6
## 801       NA NA NA NA       NA  4
## 802 4.441208  4 NA NA 3.019642 NA
## 803       NA NA NA NA       NA NA

as(movie[801:803], "matrix")[1:3, 1:6]

##     M1 M2 M3 M4 M5 M6
## 801 NA NA NA NA NA NA
## 802 NA NA NA NA NA NA
## 803 NA NA NA NA NA NA

#7、模型评估
#对于评分预测模型的评估，最经典的参数是 RMSE（均平方根误差）。rrecommenderlab 包提供了函数 evaluationScheme()建立评价方案，能够使用简单划分、k折交叉验证、自助法进行模型的评价。下面采用简单划分的方法（split），即将数据集简单分为训练集和测试集，在训练集训练模型，然后在测试集上评价。 evaluationScheme（）的主要参数：method，评估方法；train，划分为训练集的数据比例；k运行评估的折数或倍数（split的默认值为1）；given表示用来进行模型评价的items的数量。


#1)创建评估模型
model_eval <- evaluationScheme(movie[1:943], method="split", train=0.9, k=1, given=15, goodRating=5)
model_eval

## Evaluation scheme with 15 items given
## Method: 'split' with 1 run(s).
## Training set proportion: 0.900
## Good ratings: >=5.000000
## Data set: 943 x 1682 rating matrix of class 'realRatingMatrix' with 100000 ratings.

#2)对每个评估方法的耗时进行评估
#①评估方法列表：也可以为单个评估方法
algorithms <- list(popular=list(name="POPULAR", param=list(normalize="Z-score")), ubcf=list(name="UBCF", param=list(normalize="Z-score", method="Cosine", nn=25, minRating=3)), ibcf=list(name="IBCF", param=list(normalize="Z-score")))

#②对评估方法耗时进行评估：多个评估方法list类型
results <- evaluate(model_eval, algorithms, type="topNList", n=c(1, 3, 5, 10, 15, 20))

## POPULAR run 
##   1  [0.03sec/0.04sec] 
## UBCF run 
##   1  [0.03sec/19.08sec] 
## IBCF run 
##   1  [195.93sec/0.32sec]

#单个评估方法：字符串类型
result2 <- evaluate(model_eval, "IBCF", n=c(1,5, 10))

## IBCF run 
##   1  [187.8sec/0.33sec]

avg(result2)

##            TP        FP       FN       TN  precision      recall
## 1  0.08421053 0.9157895 16.91579 1649.084 0.08421053 0.009379831
## 5  0.42105263 4.5789474 16.57895 1645.421 0.08421053 0.027582452
## 10 0.69473684 9.3052632 16.30526 1640.695 0.06947368 0.053550899
##            TPR          FPR
## 1  0.009379831 0.0005545827
## 5  0.027582452 0.0027730304
## 10 0.053550899 0.0056370279

#③绘制评估方法的ROC曲线和 precision-recall曲线：recomenderlab包也提供了绘制表现图的方法，可以绘制ROC曲线和 precision-recall曲线
#绘制ROC曲线
plot(results, annotate=1:3, legend="topleft")

plot(results, annotate=3, legend="topleft")

#绘制precision-recall曲线
plot(results, "prec/rec", annotate=3)

#3）分别按照评价方法RANDOM、UBCF、IBCF建立推荐模型
model_random <- Recommender(getData(model_eval, "train"), method="RANDOM")
model_ubcf <- Recommender(getData(model_eval, "train"), method="UBCF")
model_ibcf <- Recommender(getData(model_eval, "train"), method="IBCF")

#4)分别对每个推荐模型进行预测评分：
pred_random <- predict(model_random, getData(model_eval, "known"), type="ratings")
as(pred_random, "matrix")[1:2, 1:5]

##          M1        M2        M3       M4       M5
## 2  3.168808 0.4683167 3.9833588 1.192976 4.935779
## 16       NA 2.4426126 0.5545478       NA 3.213573

pred_ubcf <- predict(model_ubcf, getData(model_eval, "known"), type="ratings")
as(pred_ubcf, "matrix")[1:2, 1:5]

##            M1       M2       M3       M4       M5
## [1,] 3.559068 3.666667 3.638294 3.638294 3.666667
## [2,]       NA 4.289384 4.147744       NA 4.228158

pred_ibcf <- predict(model_ibcf, getData(model_eval, "known"), type="ratings")
as(pred_ibcf, "matrix")[1:2, 1:5]

##    M1 M2 M3 M4 M5
## 2  NA  3 NA NA NA
## 16 NA  5  4 NA  4

#这里简单介绍，数据集是如何划分的。其实很简单，对于用户没有评分过的项目，是没法进行模型评估的，因为预测值没有参照对象。getData??的参数??given??便是来设置用于预测的项目数量。know表示用户已经评分过，用来预测的items；unknown表示用户已经评分过，用来被预测进行评估模型的items。