R小盐准备介绍R语言机器学习与预测模型的学习笔记和免费资料分享，快来收藏关注【科研私家菜】

---

01 推荐引擎系统

推荐系统有两种主要方式：协同过滤和基于内容的推荐（Ansari、Essegaier与Kohli，2000）用到的R包是recommenderlab。

① 基于用户的协同过滤

至于基于内容的推荐方法，它的理念是将用户偏好与商品属性联系在一起。对于电影和电视剧推荐来说，商品属性就是体裁、演员表和故事情节等。使用这种方法的话，推荐完全是基于用户的评价给出的，与其他任何人的评价都没有关系。基于内容的推荐方法的优点是：加入一个新项目时，它如果与某个用户档案中的兴趣偏好相符，就会被推荐给这个用户，而不必等到其他用户对它进行评价之后（这就是所谓的“第一评价”问题）。但是，基于内容的推荐方法在可用内容比较少时会遇到问题，有时是领域问题，有时发生在新用户进入系统的时候。这样就会导致不唯一的推荐，也就是糟糕的推荐。（Lops、Gemmis与Semeraro，2011）
在协同过滤推荐方法中，推荐是基于数据库中一些或全部人员提供的多条评价进行的。从本质上来说，这种方法利用的是群体的智慧。
对于协同过滤，我们重点讨论以下4种方法：
 基于用户的协同过滤
 基于项目的协同过滤
 奇异值分解
 主成分分析

在基于用户的协同过滤算法中，先找到与用户相似的近邻，然后将这些近邻的评价综合起来产生一个推荐，将其中未被用户发现的部分推荐给用户（Hahsler，2011）。可以通过KNN找出与我们要推荐的用户最相似的近邻，也可以使用带有最小阈值的其他相似度测量方式。recommenderlab包提供了两种相似度测量方式：皮尔逊相关系数和余弦相似度。

有很多方式可以对数据进行加权和控制偏差。举例来说，Flanders和其他用户相比特别喜欢打低分，所以要对他的打分进行规范化，他在某个项目上的新评分等于原评分减去他在所有项目上的评分的均值。
基于用户的协同过滤算法的缺点是，为了计算所有用户的相似度，整个数据库必须驻留在内存中，资源开销很大。

② 基于项目的协同过滤

，基于项目的协同过滤算法在进行推荐时使用的是项目之间的相似度，而
不是用户之间的相似度。这种方法背后的假设是用户更倾向于那些和他们喜欢的其他项目类似的项目（Hahsler，2011）。模型是通过计算所有项目之间的两两相似度建立起来的。常用的相似度测量方式是皮尔逊相关系数和余弦相似度。为了减小相似度矩阵的规模，可以设定只使用k个最相似的项目。但是，对近邻数目的限制会明显降低正确率，导致基于项目的协同过滤算法的性能劣于基于用户的协同过滤算法。
从下表可知，如果k = 1，那么与《疯狂的麦克斯》最相似
的项目是《美国狙击手》。于是，可以使用我对《美国狙击手》的评价来预测我对《疯狂的麦克斯》的评价：

③ 奇异值分解

。降维的方法是，建立一个更小的，但能反映高维矩阵中大部分信息的低维矩阵。
这样可能会使你发现数据中重要的潜在因子和相应的权重，这些因子也许会揭示一些评价矩阵中的重要信息，比如电影体裁或书籍主题。尽管你可能无法辨别有意义的因子，但降维技术也可以过滤数据中的噪声。
大数据集的一个问题是，你很可能得到一个稀疏矩阵，其中很多评价是空白的。降维技术的缺点是不能支持带有缺失值的矩阵，必须进行数据填补。recommenderlab包中的默认方式是使用中位数。
奇异值分解是一种矩阵分解方法，有助于将一组关联特征转换为不关联的特征。假设有矩阵A，这个矩阵可以分解为3个矩阵：U、D和VT。U是一个正交矩阵，D是一个半正定对角矩阵，VT是一个正交矩阵的转置。
使用R基础包中的svd()函数，将评价矩阵分解为上面所说的3个矩阵，R将其分别命名为u和u中的值就是某个用户在相应因子上的载荷，$v中的值是某个电影在相应维度上的载荷

ratings <- c(3,5,5,5,1,1,5,2,5,1,1,5,3,5,1,5,4,2,4,3,4,2,1,4)
ratingMat <- matrix(ratings, nrow = 6)
rownames(ratingMat) <- c("Homer","Marge","Bart","Lisa","Flanders","Me")
colnames(ratingMat) <- c("Avengers","American Sniper","Les Miserable","Mad Max")
ratingMat
svd <- svd(ratingMat)
svd
sum(svd$d)
var <- sum(svd$d[1:2])
var
var/sum(svd$d)

f1 <- function(x) {
  score = 0
  for(i in 1:n )
    score <- score + svd$u[, i] %*% t(svd$v[, i]) * svd$d[i] 
  return(score)
}
n = 4
f1(svd)
n = 2
f1(svd)

效果如下：

④ 主成分分析

主成分分析和奇异值分解具有相似的作用。实际上，这两种技术连接非常紧密，经常交互使用，因为它们都用到了矩阵分解技术。那么，它们之间的区别是什么？
简言之，主成分分析是基于协方差矩阵的，这个矩阵是对称的。要进行主成分分析，需要先从数据开始，对数据进行中心化，然后计算协方差矩阵并进行对角化，最后生成主成分。

library(psych)
pca <- principal(ratingMat, nfactors = 2, rotate = "none")
pca

library(recommenderlab)
data(Jester5k)
Jester5k
as(Jester5k[10, ], "list")
rowMeans(Jester5k[10, ])
colMeans(Jester5k[, 1])
hist(getRatings(Jester5k), breaks = 100)
hist(getRatings(normalize(Jester5k)), breaks = 100)
hist(rowCounts(Jester5k), breaks = 50)

---

02 推荐系统模型预测R语言实现

set.seed(123)
e <- evaluationScheme(Jester5k, 
                      method = "split", train = 0.8, 
                      given=15, goodRating = 5)
recommenderRegistry$get_entries(dataType = "realRatingMatrix")
ubcf <- Recommender(getData(e, "train"), "UBCF")
ibcf <- Recommender(getData(e, "train"), "IBCF")
svd <- Recommender(getData(e, "train"), "SVD")
popular <- Recommender(getData(e, "train"), "POPULAR")
pca <- Recommender(getData(e, "train"), "PCA")
random <- Recommender(getData(e, "train"), "RANDOM")

ubcf_pred <- predict(ubcf, getData(e, "known"), type = "ratings")
ibcf_pred <- predict(ibcf, getData(e, "known"), type = "ratings")
svd_pred <- predict(svd, getData(e, "known"), type = "ratings")
pop_pred <- predict(popular, getData(e, "known"), type = "ratings")
ran_pred <- predict(random, getData(e, "known"), type = "ratings")

P1 <- calcPredictionAccuracy(ubcf_pred, getData(e, "unknown"))
P1
P2 <- calcPredictionAccuracy(ibcf_pred, getData(e, "unknown"))
P3 <- calcPredictionAccuracy(svd_pred, getData(e, "unknown"))
P4 <- calcPredictionAccuracy(pop_pred, getData(e, "unknown"))
P5 <- calcPredictionAccuracy(ran_pred, getData(e, "unknown"))

error <- rbind(P1, P2, P3, P4, P5)
rownames(error) <- c("UBCF", "IBCF", "SVD", "Popular", "Random")
error

algorithms <- list(
  POPULAR = list(name = "POPULAR"),
  UBCF = list(name = "UBCF"),
  IBCF = list(name = "IBCF"))
algorithms

evlist <- evaluate(e, algorithms, n = c(5, 10, 15))
options(digits = 3)
set.seed(1)
avg(evlist)
plot(evlist, legend = "topleft", annotate = TRUE)
plot(evlist, "prec", legend = "bottomright", annotate = TRUE)

R1 <- Recommender(Jester5k, method = "POPULAR")
R1
recommend <- predict(R1, Jester5k[1:2], n = 5)
as(recommend, "list")
rating <- predict(R1, Jester5k[300:309], type = "ratings")
rating
as(rating, "matrix")[, 71:73]

Jester.bin <- binarize(Jester5k, minRating = 5)
Jester.bin <- Jester.bin[rowCounts(Jester.bin) > 10]
Jester.bin
set.seed(456)
e.bin <- evaluationScheme(Jester.bin, 
                          method = "cross-validation", k = 5, given = 10)
algorithms.bin <- list("random" = list(name="RANDOM", param=NULL),
                       "popular" = list(name = "POPULAR", param = NULL),
                       "UBCF" = list(name="UBCF"))
results.bin <- evaluate(e.bin, algorithms.bin, n = c(5, 10, 15))
plot(results.bin, legend  ="topleft")
plot(results.bin, "prec", legend = "bottomright")

效果如下：

---

关注R小盐，关注科研私家菜(VX_GZH: SciPrivate)，有问题请联系R小盐。让我们一起来学习 R语言机器学习与临床预测模型