R語言-推薦系統

一.概述

目的:使用推薦系統可以給用戶推薦更好的商品和服務,使得產品的利潤更高

算法:協同過濾

協同過濾是推薦系統最常見的算法之一,算法適用用戶過去的購買記錄和偏好進行推薦

基於商品的協同過濾(IBCF計算每個商品之間的相似度矩陣):

　　1.任意兩個商品計算相似度

　　2.每一個商品找出其k個最相似的商品

　　3.每一個用戶找出那些商品與其之前購買的商品最接近的商品

基於用戶的協同過濾(UBCF計算用戶之間的相似度矩陣):

　　1.計算每個用戶與用戶之間的相似度,通常使用皮爾森相關系數和余弦距離

　　2.找出最相近的用戶(KNN)

　　3.把新用戶最相似的用戶所購買的商品進行排名

　　4.基於相似性矩陣選出n個推薦的商品

二.案例

案例1:基於電影數據集的推薦(IBCF)

　　1.1導入包

library(reshape2)
library(ggplot2)
library(countrycode)
library(recommenderlab)

　　1.2查看數據集

data("MovieLense")
dim(MovieLense)
str(MovieLense)
head(MovieLense@data)

　

　　結論:該數據集是一個稀疏矩陣,每一行是觀眾對每部電影的打分,每一列是電影,一共有943觀眾,1664部電影

　　1.3找到評分大於0的電影

vector_rating <- as.vector(MovieLense@data)
table_rating <- table(vector_rating)

#查看非0的評分
vector_rating <- vector_rating[vector_rating!=0]
vector_rating <- factor(vector_rating)
qplot(vector_rating) + ggtitle('Distribution of the ratings')

　　結論:3,4分的電影比較多

　　1.4找到被評分較多的電影和打分比較多的觀眾

#找到評分比較多的電影和打分比較多的用戶
rating_moives <- MovieLense[rowCounts(MovieLense) > 50,colCounts(MovieLense) > 100]
dim(rating_moives)

　　結論:只有560部電影和322位觀眾符合條件

　　1.5划分數據集

#80%位訓練集,20%位測試集
which_train <- sample(x=c(T,F),size = nrow(rating_moives),replace = T,prob = c(0.8,0.2))
recc_data_train <- rating_moives[which_train,]
recc_data_test <- rating_moives[!which_train,]

　　1.6建立推薦模型

#IBCF是基於商品的推薦
recc_model=Recommender(data = recc_data_train,method="IBCF")

　　1.7查看模型

model_detail <- getModel(recc_model)
model_detail$description
str(model_detail)

dim(model_detail$sim)
n_items_top <- 20
image(model_detail$sim[1:n_items_top,1:n_items_top],main = "Heatmap of the first rows and columns")

　　結論:從相似性矩陣中抽取20*20的數據進行熱圖展示,顏色越深的電影相關性越大

　　1.8使用模型進行推薦

#定義推薦的個數
n_recommended <- 6
recc_predicted <- predict(object = recc_model,newdata=recc_data_test,n=n_recommended)
recc_user_1 <- recc_predicted@items[[1]]
moive_user_1 <- recc_predicted@itemLabels[recc_user_1]
#查看第一個用戶的推薦結果
moive_user_1

使用基於用戶的電影推薦(UBCF)

 　　1.9建立基於用戶的模型

recommender_models <- recommenderRegistry$get_entries(dataType ="realRatingMatrix")

　　1.10查看參數

recommender_models$UBCF_realRatingMatrix$parameters

　　結論:使用cosine來計算每個用戶的相似性

　　1.11建立相關性矩陣

recc_model_UBCF = Recommender(data = recc_data_train,method='UBCF',
                              param=list(normalize='Z-score',nn=5,method='Cosine'))
model_detail_UBCF <- getModel(recc_model_UBCF)
names(model_detail_UBCF)
model_detail_UBCF$dat

　　結論:模型的參數

　　1.12使用模型進行推薦

recc_predicted_UBCF <- predict(object = recc_model_UBCF,newdata=recc_data_test,n=n_recommended)

　　1.13查看推薦的結果

recc_martix <- sapply(recc_predicted_UBCF@items, function(x){
  colnames(rating_moives[x])
})
dim(recc_martix)
recc_martix[,1:4]

　　結論:根據用戶進行推薦的結果

對二進制的數據進行建模(一般應用於網頁的商品推薦)

## 基於商品的建模

recc_model=Recommender(recc_data_train,method="IBCF", param=list(method="Jaccard"))
model_details <- getModel(recc_model)
###定義推薦個數
n_recommended <- 6
recc_predicted <- predict(object = recc_model, newdata = recc_data_test, n = n_recommended)
recc_matrix <- sapply(recc_predicted@items, function(x){
  colnames(ratings_movies)[x]
})

recc_matrix[, 1:4]

###UBCF
##基於用戶的建模
recc_model=Recommender(recc_data_train,method="UBCF", param=list(method="Jaccard"))
model_details <- getModel(recc_model)

n_recommended <- 6
recc_predicted <- predict(object = recc_model, newdata = recc_data_test,n = n_recommended)
recc_matrix <- sapply(recc_predicted@items, function(x){
  colnames(ratings_movies)[x]
})
dim(recc_matrix)

recc_matrix[, 1:4]

 

　　　　　　　　       IBCF 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　UBCF

使用 k-fold對模型進行驗證

 　　1.14使用交叉驗證

eval_set <- evaluationScheme(data=rating_moives,method='cross-validation',k=4,given=15,goodRating=3)
# 不同類型的模型和隨機推薦進行比較
models_to_evaluate <- list(
  IBCF_cos = list(name='IBCF',param=list(method='cosine')),
  IBCF_cor = list(name='IBCF',param=list(method='pearson')),
  UBCF_cos = list(name='UBCF',param=list(method='cosine')),
  UBCF_cor = list(name='UBCF',param=list(method='pearson')),
  random = list(name='Random',param=NULL)
)

　　1.15作圖比較

##定義推薦電影的個數
n_recommendations <- c(1, 5, seq(10, 100, 10))

##開始建模
list_results <- evaluate(x = eval_sets, method = models_to_evaluate, n
                         = n_recommendations)


### plot #通過做圖查看模型差異

plot(list_results, annotate = 1, legend = "topleft")

title("ROC curve")

　　結論:使用基於用戶的皮爾森作為推薦的模型是最優的

　　1.16對參數進行優化

# 參數優化
vector_k <- c(5, 10, 20, 30, 40)


models_to_evaluate <- lapply(vector_k, function(k){
  list(name = "IBCF", param = list(method = "cosine", k = k))
})


names(models_to_evaluate) <- paste0("IBCF_k_", vector_k)


n_recommendations <- c(1, 5, seq(10, 100, 10))
list_results <- evaluate(x = eval_set, method = models_to_evaluate, n
                         = n_recommendations)

par(mar=c(1.1 ,1.1, 1.1, 1.1))

plot(list_results, annotate = 1, legend = "topleft")
title("ROC curve")

　　

　　結論:基於商品的推薦模式下,每個用戶推薦30部是最優策略

案例2基於網頁的推薦(用戶沒有對網頁評分,是根據用戶點擊瀏覽網頁來獲取用戶的行為作為推薦的依據)

　　2.1導入包

library(data.table)
library(reshape2)
library(ggplot2)
library(countrycode)
library(recommenderlab)

　　2.2查看並清洗數據集

web_data <- read.csv('E:\\Udacity\\Data Analysis High\\R\\R_Study\\高級課程代碼\\數據集\\第二天\\5推薦系統\\anonymous-msweb.test.txt',header=FALSE)
head(web_data)
#選擇前兩列
table_users <- web_data[, 1:2]
##定義成data frame
table_users <- data.table(table_users)
#定義列名稱
setnames(table_users, 1:2, c("category", "value"))
table_users <- table_users[category %in% c("C", "V")]
head(table_users)

 

　　結論:

　　　　1.該數據集一共有20492個對象,每個對象有6列

　　　　2.該數據集的前兩列C的value表示用戶ID,V的value表示用戶訪問的網頁ID

 　　2.3將數據表轉化成寬表

#每遇到一個新用戶則chunk user +1
table_users[, chunk_user := cumsum(category == "C")]
head(table_users)
tail(table_users)

### 把user 和item 分成兩列
table_long <- table_users[, list(user = value[1], item = value[-1]), by ="chunk_user"]
head(table_long)


### long to wide 長表變寬表
table_long[, value := 1]
table_wide <- reshape(data = table_long,
                      direction = "wide",
                      idvar = "user",
                      timevar = "item",
                      v.names = "value")
head(table_wide[, 1:8, with = FALSE])

 

 

　　   step1　　　　　　　　　　　　　　step2　　　　　　　　　　　　　　　　　　　　　　　　　　step3

　　2.4將寬表的列名進行修正(第一列是用戶id,之后的每一列是Item id,每一個值是代表用戶是否訪問過該頁面)

# 保存用戶的id
vector_users <- table_wide[,user]
# 從數據集刪除用戶ID和chunk_user
table_wide[, user := NULL]
table_wide[, chunk_user := NULL]


##對列名稱進行修正，只取前7個字符
setnames(x = table_wide,
         old = names(table_wide),
         new = substring(names(table_wide),7))

# 添加行名稱,並轉化成矩陣
matrix_wide <- as.matrix(table_wide)
rownames(matrix_wide) <- vector_users
head(matrix_wide[,1:6])

　　2.5畫出相關性熱力圖

# 轉換成二進制矩陣
matrix_wide[is.na(matrix_wide)] <- 0
ratings_matrix <- as(matrix_wide, "binaryRatingMatrix")

image(ratings_matrix[1:50, 1:50], main = "Binary rating matrix")

　　2.6獲取其他的信息

# 如果有一些網頁，在五千個人中訪問不超過5的，則刪掉
ratings_matrix <- ratings_matrix[, colCounts(ratings_matrix) >= 5]
# 如果有一些用戶，在網頁中點評數量少於5個則刪除
ratings_matrix <- ratings_matrix[rowCounts(ratings_matrix) >= 5, ]

# 獲取描述信息
table_in <- data.table(table_in)
table_items <- table_in[V1 == "A"]
head(table_items)

# 修改列名
table_items <- table_items[,c(2,4,5),with=F]
setnames(table_items,1:3,c('id','description','url'))
table_items <- table_items[order(id)]

# 新增一列category,默認是product,如果描述在country_code中則category改為region
table_items[,category := 'product']
name_countries <-c(countrycode_data$country.name)
                    
table_items[description %in% name_countries, category := "region"]

table_items[, list(n_items = .N), by = category]

 

　　　　    step1  　　　　　　　　　　　　　　　　　　　　　　　　step2                                                               step3

 　　2.7划分數據集

which_train <- sample(x=c(T,F),
                      size = nrow(ratings_matrix),
                      replace = T,
                      prob = c(0.8,0.2)
                      )
recc_data_train <- ratings_matrix[which_train,]
recc_data_test <- ratings_matrix[!which_train,]

　　2.8基於商品的推薦模型

web_model <- Recommender(data=recc_data_train,method='IBCF',parameter=list(method='Jaccard'))

　

　　2.9計算相似性矩陣

## item 的相似性矩陣(評分矩陣)
dist_ratings <- as(web_model@model$sim, "matrix")

## item category的相似性矩陣(商品之間的相似性矩陣)
dist_category <- table_items[, 1 - dist(category == "product")]
dist_category <- as(dist_category, "matrix")

dim(dist_category)
dim(dist_ratings)

## 給dist_category矩陣添加行名和列名
rownames(dist_category) <- table_items[, id]
colnames(dist_category) <- table_items[, id]

## 給dist_category矩陣抽取dist_ratings的長度,兩個矩陣的大小要一致
vector_items <- rownames(dist_ratings)
dist_category <- dist_category[vector_items, vector_items]
dim(dist_category)

     

　　step1　　　　　　　　　　step2

　　2.10使用模型進行預測

## category matrix 包含信息較少，所以只給0.25的權重
weight_catrgory <- 0.25
dist_tot <- dist_category * weight_catrgory + dist_ratings * (1-weight_catrgory)
## 轉換成相似性矩陣
web_model@model$sim <- as(dist_tot,'dgCMatrix')
## 設定推薦的個數
n_recommend <- 10
web_predict <- predict(object = web_model,newdata=recc_data_test,n=n_recommend)
head(web_predict@itemLabels,10)

　　結論:該用戶最想看到的10個網站的ID

 

 總結:

　　1.了解業務需求

　　2.載入包

　　3.清洗並轉換數據集

　　4.拆分數據集

　　5.建立IBCF模型,如果兩個網站被相同用戶訪問的越多,其相似度越大

　　6.使用對網站的描述建立描述相似性矩陣,如果是相同的類型則為1,否則是0

　　7.對兩個相似性矩陣進行加權平均

　　8.使用模型進行預測

 數據集:https://github.com/Mounment/R-Project