• 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

  • 相关阅读:
    MySQL使用DDL语句创建表
    MySQL之删_delete-truncate
    APP安全在线检测
    Linux提权:从入门到放弃
    phpmyadmin新姿势getshell
    一次完整的从webshell到域控的探索之路
    我的WafBypass之道(Misc篇)
    我的WafBypass之道(upload篇)
    我的WafBypass之道(SQL注入篇)
    使用Bitsadmin 命令下载文件
  • 原文地址:https://www.cnblogs.com/luhuajun/p/8716278.html
Copyright © 2020-2023  润新知