Recommenderlab评估代码分析

Recommenderlab评估代码分析

recommenderlab 包提供了专门的评估函数evaluationScheme()，能够设置采用多种验证方法：

1、  cross-validation  n 折交叉验证

2、  bootstrap 重复抽样

3、split 简单的训练集/测试集分开验证

 

本文尝试通过解析代码方式解释后一种方法，即将数据集简单分为训练集和测试集，在训练集训练模型，然后在测试集上评估。

一、将数据分成Training和Testing

（此图来自参考文献1）

一、将数据分成Training和Testing

 

将数据分成Training和Testing的示例代码：

library(recommenderlab)

data(MovieLense)

scheme <- evaluationScheme(MovieLense, method = "split",train = 0.9, k = 1,

given = 10, goodRating = 4)

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"))

)

results <- evaluate(scheme, algorithms, n =c(1, 3, 5, 10, 15, 20))

 

evaluationScheme（）的主要参数：

method，评估方法（默认值split）

train，划分为训练集的数据比例（method为split时，默认值为0.9）

k运行评估的折数或倍数（method为split时，默认值为NULL）

given表示用来进行模型评价的items的数量（默认值为3）

goodRating 表示预测成功的最小评分（默认值为NA），realRatingMatrix时goodRating为必须的参数

 

evaluate(scheme, algorithms, n = c(1, 3, 5,10, 15, 20))的主要参数：

scheme evaluationScheme数据集定义

algorithms待评估算法的参数定义

n n = c(1, 3, 5, 10, 15, 20) 评估各种情况的topN，比如top1 top3top5 ……

 

given 值对协同过滤的推荐系统影响很大，given 越大（用于预测项目数量）RMSE越小，当然这里最大的given 值为20，在[1, 20]范围内，显然given = 20 是最优的。

---语自参考文献1

 

注：在生产数据的测试中，given只能等于1，原因是部分item只有一个。

 

二、将Testing分成Known和Unknown

“know”和“unknow”表示对测试集的进一步划分：“know”表示用户已经评分的，要用来预测的items；“unknow”表示用户已经评分，要被预测以便于进行模型评价的items。

2.1、realRatingMatrix的Known和Unknown处理

在realRatingMatrix.R的代码中有内部函数.splitKnownUnknown

## create test data

setMethod(".splitKnownUnknown",signature(data="realRatingMatrix"),

         function(data,given) {

 

                   ##given might of length one or length(data)

                   if(length(given)==1)given <- rep(given, nrow(data)) #2,2,2,2,2,…..

 

                   ##we create a logical mask via a triplet Matrix

                   trip<- as(data, "dgTMatrix")        

                   items<- lapply(0:(nrow(data)-1),      #评分矩阵变成列表

                            function(i)which(trip@i == i))

 

                   take<-  unlist(lapply(1:length(items), #每item都抽given条记录组成验证集known

                                     function(i)sample(items[[i]],given[i])))

 

                   tripUnknown<- trip                                      #测试集testing

                   tripUnknown@x<- tripUnknown@x[-take]     #Unknown=testing– Known

                   tripUnknown@i<- tripUnknown@i[-take]

                   tripUnknown@j<- tripUnknown@j[-take]

                   tripKnown<- trip

                   tripKnown@x<- tripKnown@x[take]

                   tripKnown@i<- tripKnown@i[take]

                   tripKnown@j<- tripKnown@j[take]

 

                   known<- new("realRatingMatrix",

                            data= as(tripKnown, "dgCMatrix"))

                   unknown<- new("realRatingMatrix",

                            data= as(tripUnknown, "dgCMatrix"))

 

                   list(

                            known= known,

                            unknown= unknown

                   )

         })

 

Known是根据given值随机抽取的。

2.1、binaryRatingMatrix的Known和Unknown处理

## split test data

setMethod(".splitKnownUnknown",signature(data="binaryRatingMatrix"),

         function(data,given) {          #testData <-.splitKnownUnknown(data, given)

 

                   ##given might of length one or length(data)

                   if(length(given)==1)given <- rep(given, nrow(data)) #2,2,2,2,2,…..

 

                   l<- getList(data, decode=FALSE)

                   known_index<- lapply(1:length(l),

                            FUN= function(i) sample(1:length(l[[i]]), given[i])) #

 

                   known<- encode(

                            lapply(1:length(l),FUN = function(x)

                                     l[[x]][known_index[[x]]]),

                            itemLabels= itemLabels(data@data))

 

                   unknown<- encode(

                            lapply(1:length(l),FUN = function(x)

                                     l[[x]][-known_index[[x]]]),

                            itemLabels= itemLabels(data@data))

 

 

                   known<- new("binaryRatingMatrix", data = known)

                   unknown<- new("binaryRatingMatrix", data = unknown)

 

                   list(

                            known= known,

                            unknown= unknown

                   )

         })

 

Known是根据given值随机抽取的。

 

三、评估的代码块

         在evaluate.R的代码中：

## prepare data

         train<- getData(scheme, type="train", run=run)

         test_known<- getData(scheme, type="known", run=run)

         test_unknown<- getData(scheme, type="unknown", run=run)

 

         ###binarize a realRatingMatrix?

         if(is(test_known, "realRatingMatrix")) {

             if(is.na(scheme@goodRating)) stop("Youneed to set goodRating in the evaluationScheme for a realRatingMatrix!")

 

             test_unknown <- binarize(test_unknown,scheme@goodRating) #test_unknown大于goodRating部分

         }

 

         ##train recommender

         time_model<- system.time(

                   r<- Recommender(train, method, parameter=parameter) #用train产生推荐结果

                   )

        

         cm<- matrix(NA, nrow=length(n), ncol=9,

                   dimnames=list(n=n,

                            c("TP","FP", "FN", "TN", "PP","recall","precision","FPR","TPR")))

        

         time_predict<- system.time(

                   topN<- predict(r, test_known, n=max(n))  #从test_known中用模型预测，取最长的topNList，其他结果截取头几个即可

                   )

        

         for(iin 1:length(n)) {

                   NN<- n[i]                          #top1 top3 top5……

 

                   ##get best N

                   pred<- bestN(topN, NN)

 

                   ##create confusion matrix

                   tp<- rowSums(as(pred, "ngCMatrix") * as(test_unknown,"ngCMatrix"))  #pred与测试集test_unknown的交集，表示预测成功的

                   ##The algorithm predicted known items!!!

                   pred_known<- rowSums(as(pred, "ngCMatrix") * as(test_known,"ngCMatrix")) #pred与验证集test_known的交集

                   if(any(pred_known>0))warning(paste("The algorithm ",

                                     r@model,"predicted known items!!!"))

 

                   tp_fn<- rowCounts(test_unknown)  #tp+fn=n

                   tp_fp<- rowCounts(pred)          #tp+fp=p

 

                   cm[i,"TP"] <- mean(tp)

                   cm[i,"FP"] <- mean(tp_fp - tp)    #fp=p-tp

                   cm[i,"FN"] <- mean(tp_fn - tp)    #fn=n-tp

                   ##Reduced TN by the number of given items. Bug

                   ##reported by (Zhang, Martin F)

                   ##mean if given has multiple values (reported by Luca Marotta)

                   cm[i,"TN"] <- ncol(train) - mean(scheme@given) + mean(pred_known) -cm[i, "TP"] -  cm[i,"FP"] - cm[i, "FN"]                  #tn=train_all –given+pred_known-tp-fp-fn

                   cm[i,"PP"] <- mean(tp_fp)        #pp=p

 

                   ##calculate some important measures

                   cm[i,"precision"] <- cm[i, "TP"] / (cm[i, "TP"] +cm[i, "FP"]) #precision=tp/(tp+fp)

                   cm[i,"recall"] <- cm[i, "TP"] / (cm[i, "TP"] +cm[i, "FN"])   #recall=tp/(tp+fn)

                   cm[i,"TPR"] <- cm[i, "recall"]                        #tpr=recall

                   cm[i,"FPR"] <- cm[i, "FP"] / (cm[i, "FP"] + cm[i,"TN"])    #fpr=fp/(fp+tn)

 

 

3.1、realRatingMatrix的binarize处理

只获取大于goodRating的item：

## binarize

setMethod("binarize", signature(x= "realRatingMatrix"),

         function(x,minRating, ...){

                   x<- x@data

                   x@x<- as.numeric(x@x>=minRating)

                   x<- drop0(x)

                   if(is.null(colnames(x)))colnames(x) <- 1:ncol(x)

                   x<- new("itemMatrix", data = t(as(x, "ngCMatrix")),

                            itemInfo= data.frame(labels=colnames(x)))

                   new("binaryRatingMatrix",data = x)

         })

 

 

参考文献：

1 recommenderlab包实现电影评分预测 http://cos.name/2014/02/recommenderlab-packages/

2 recommenderlab:构建基于R的推荐系统 http://site.douban.com/182577/widget/notes/10567212/note/345073868/