看书标记【R语言 商务数据分析实战7】

【R语言 商务数据分析实战7】

---

chapter 7

电子商务网站智能推荐服务

数据库接入+数据预处理（去噪去重）>>协同过滤算法（相似度）对网站进行智能推荐

7.2 任务实现

原始数据有关于用户属性和浏览网站的行为数据（用户访问日志），提前对网站和用户分类有助于减少计算量和提高正确率。
使用R连接数据库并提取数据

# 设置工作目录并读取数据
setwd()
require(RMySQL)

# 建立R与数据库的连接
# 修改成自己数据库名称、用户名、密码、端口等
con <- dbConnect(MySQL(), host = "127.0.0.1", port = 3306, dbname = "law",
                 user = "root", password = "root")

# 修改此连接的编码为中文，只针对此连接有效。gbk可以在数据源的属性中进一步设置，目的是避免中文乱码
dbSendQuery(con, "set character_set_results = gbk")
dbSendQuery(con, "set character_set_connection = gbk")
dbSendQuery(con, "set character_set_database = gbk")
dbSendQuery(con, "set character_set_client = gbk")

# R通过连接对表按条件查询,选取数据库中所有的原始数据
con.query <- dbSendQuery(con, "select * from all_gzdata")

# 提取查询到的数据，n = -1代表提取所有数据，n = 100代表提取前100行
all.gzdata <- dbFetch(con.query, n = -1)
write.csv(all.gzdata, "./tmp/all_gzdata.csv", row.names = FALSE)
# 关闭连接
dbDisconnect(con)
# 如果需要通过R的连接进行中文查询，可能需要修改下面的编码
# set character_set_client = gbk  # 客户端编码方式
# set character_set_connection = gbk  # 建立连接使用的编码
# set character_set_database = gbk  # 数据库的编码
# set character_set_results = gbk  # 结果集的编码
# set character_set_server = gbk  # 数据库服务器的编码

统计网页整体流量情况

# 设置工作目录
setwd()
library(stringr)
library(plyr)
all.gzdata <- data.table::fread("./tmp/all_gzdata.csv")  # 快速读取数据

统计分析网页类型

# 将网页类型数据只取到前三位数，如107、109等
web.type <- all.gzdata[, (type = str_sub(fullURLId, 1, 3))]
web.number <- as.data.frame(table(web.type))
web.number <- web.number[order(web.number$Freq, decreasing = TRUE), ]
web.number$proportion <- web.number$Freq / nrow(all.gzdata)  # 计算每一类的占比

# 统计101开头的网页类型
start101 <- all.gzdata[which(str_sub(fullURLId, 1, 3) == 101), ]
times101 <- as.data.frame(table(start101$fullURLId))
times101 <- times101[order(times101$Freq, decreasing = TRUE), ]  # 降序
times101$proportion <- times101$Freq / sum(times101$Freq)  # 计算每一类的占比

# 统计107开头的网页类型
start107 <- all.gzdata[grep("107", all.gzdata$fullURLId), ]
nrow(start107)  # 182900条记录
# 提取知识内容页的数据
start107.nr <- start107[grep("\\d+\\.html", start107$fullURL), ]
nrow(start107.nr)  # 164928条记录
start107.fnr <- start107[-grep("\\d+\\.html", start107$fullURL), ]  # 删除内容页
# 提取知识首页的数据
start107.sy <- start107.fnr[grep("info/[[:alpha:]]+/$", start107.fnr$fullURL), ]
nrow(start107.sy)  # 9001条记录
# 提取知识列表页的数据
start107.lb2 <- start107.fnr[grep("info/[[:alpha:]]+/[[:alpha:]]+/$", 
                                  start107.fnr$fullURL), ]  # 8177条记录
start107.fnr <- start107.fnr[-grep("info/[[:alpha:]]+/[[:alpha:]]+/$", 
                                   start107.fnr$fullURL), ]
start107.lb3 <- start107.fnr[grep("info/[[:alpha:]]+/[[:alpha:]]+/[[:alpha:]]+/$", 
                                  start107.fnr$fullURL), ]  # 615条记录
start107.lb4 <- start107.fnr[grep("info/[[:alpha:]]+/[[:alpha:]]+/[[:alpha:]]+/[[:alpha:]]+/", 
                                  start107.fnr$fullURL), ]  # 21条记录
# 统计知识列表页的记录总数（共9278条）
nrow(start107.lb2) + nrow(start107.lb3) + nrow(start107.lb4)

# ----------------------------统计199开头的网页数据-----------------------------
# 提取199开头的网页
start199 <- all.gzdata[grep("199", all.gzdata$fullURLId), ]
nrow(start199)  # 201426条记录

# 提取带有“?”的数据
start199.wh <- start199[grep("\\?", start199$fullURL), ]
nrow(start199.wh)  # 64718条记录
start199 <- start199[-grep("\\?", start199$fullURL), ]

# 统计法规网址(网址带有fagui或wuquan.lawtime.cn主页的网址)
start199.fg1 <- start199[grep("/fagui", start199$fullURL), ]  # 46995条记录
start199 <- start199[-grep("/fagui", start199$fullURL), ]
start199.fg2 <- start199[grep("http://www.law.lawtime.cn/", 
                              start199$fullURL), ]  # 6条记录
start199.fg3 <- start199[grep("http://wuquan.lawtime.cn/wqbh/ccshpc/", 
                              start199$fullURL), ]  # 1条记录
# 统计法规网址的记录总数（共47002条）
nrow(start199.fg1) + nrow(start199.fg2) + nrow(start199.fg3)

# 统计咨询相关
start199.ask <- start199[grep("ask", start199$fullURL), ]  # 35812条记录
start199 <- start199[-grep("ask", start199$fullURL), ]
# 咨询相关的其他网址
start199.ask2 <- start199[grep("http://www.urlshare.cn/mqz_url_check", 
                               start199$fullURL), ]  # 1条记录
start199 <- start199[-grep("http://www.urlshare.cn/mqz_url_check", 
                           start199$fullURL), ]
# 统计法规网址的记录总数（共35813条记录）
nrow(start199.ask) + nrow(start199.ask2)

# 统计地区和律师相关的网页
# 统计律师在线搜索
start199.onlinesearch <- start199[grep("http://www.lawtime.cn/onlinesearch", 
                                       start199$fullURL), ]  # 193条记录
start199 <- start199[-grep("http://www.lawtime.cn/onlinesearch", start199$fullURL), ]
# 统计律师在线|律师咨询页面(全国律师)
start199.china <- start199[grep("http://www.lawtime.cn/china", 
                                start199$fullURL), ]  # 343条记录
start199 <- start199[-grep("http://www.lawtime.cn/china", 
                           start199$fullURL), ]

start199.china2 <- start199[grep("http://www.lawtime.cn/400/china", 
                                 start199$fullURL), ]  # 3条记录
start199 <- start199[-grep("http://www.lawtime.cn/400/china", start199$fullURL), ]
# 统计广州律师在线页面
start199.online <- start199[grep("http://www.lawtime.cn/online", 
                                 start199$fullURL), ]  # 73
start199 <- start199[-grep("http://www.lawtime.cn/online", start199$fullURL), ]
# 统计律师网(主要是省级或直辖市的)
start199.lsw <- start199[grep("律师网 - ", start199$pageTitle), ]  # 488条记录
start199 <- start199[-grep("律师网 - ", start199$pageTitle), ]
# 统计地区列表
start199.citylist <- start199[grep("citylist", start199$fullURL), ]  # 3878条记录
start199 <- start199[-grep("citylist", start199$fullURL), ]
# 统计地区和律师事务所
# 律师事务所，以lawfirm结尾
start199.dq <- start199[grep("lawfirm", start199$fullURL), ]  # 3811条记录
start199 <- start199[-grep("lawfirm", start199$fullURL), ]
# 统计地区律师（主要是市级的）
start199.dq2 <- start199[grep("http://www.lawtime.cn/[[:alpha:]]*$", 
                              start199$fullURL), ]  # 30161条记录
start199 <- start199[-grep("http://www.lawtime.cn/[[:alpha:]]*$", start199$fullURL), ]
# 统计地区律师的特殊网页
start199.dq3 <- start199[grep("p\\d+_[[:alpha:]]+", 
                              start199$fullURL), ]  # 270条记录
start199 <- start199[-grep("p\\d+_[[:alpha:]]+", start199$fullURL), ]

# 统计法律快车地区律师
start199.dq4 <- start199[grep("http://lvshi.lawtime.cn", 
                              start199$fullURL), ]  # 598条记录
start199 <- start199[-grep("http://lvshi.lawtime.cn", start199$fullURL), ]
# 统计另一类特征地区律师
start199.dq5 <- start199[grep("http://www.lawtime.cn/tklawyer", 
                              start199$fullURL), ]  # 26条记录
start199 <- start199[-grep("http://www.lawtime.cn/tklawyer", start199$fullURL), ]
# 广州律师在线的特殊网址
start199.dq6 <- start199[grep("http://www.lawtime.cn/guangzhou/online/", 
                              start199$fullURL), ]  # 2条记录
# 共39846条记录
nrow(start199.onlinesearch) + nrow(start199.china) + nrow(start199.china2) +
  nrow(start199.online) + nrow(start199.lsw) + nrow(start199.citylist) +
  nrow(start199.dq) + nrow(start199.dq2) + nrow(start199.dq3) + 
  nrow(start199.dq4) + nrow(start199.dq5) + nrow(start199.dq6)

# ---------------------------统计带有“?”的数据数据------------------------------
# 统计原始数据中带有“?”的数据
gzdata.wh <- all.gzdata[grep("\\?", all.gzdata$fullURL), ]  # 65492条记录
wh <- as.data.frame(table(gzdata.wh$fullURLId))
wh <- wh[order(wh$Freq, decreasing = TRUE), ]
wh$proportion <- wh$Freq / sum(wh$Freq)  # 计算每一类的占比

# 筛选出1999001类型
web199 <- gzdata.wh[which(gzdata.wh$fullURLId == 1999001), ]  # 64718条记录
# 统计法律快车-律师助手的数据
web199.kc <- web199[grep('^法律快车-律师助手$', web199$pageTitle), ]  # 49894条记录
web199 <- web199[-grep('^法律快车-律师助手$', web199$pageTitle), ]
# 统计咨询发布成功类信息
web199.fb1 <- web199[grep('^咨询发布成功', web199$pageTitle), ]  # 5220条记录
web199 <- web199[-grep('^咨询发布成功', web199$pageTitle), ]
# 统计法律-咨询服务数据
web199.fb2 <- web199[grep('^免费发布法律咨询 - 法律快车法律咨询$', 
                          web199$pageTitle), ]  # 6166条记录
web199 <- web199[-grep('^免费发布法律咨询 - 法律快车法律咨询$', web199$pageTitle), ]
# 统计快搜数据
web199.ks <- web199[grep('法律快搜-中国法律搜索第一品牌', 
                         web199$pageTitle), ]  # 342条记录


# 统计没有明确的目标访问的网页类型
# 没有明确的目标访问的网址是没有以.html结尾的
# 所以删除以html为后缀的网页，即得到瞎逛用户
wander <- all.gzdata[-which(str_sub(all.gzdata$pagePath, -5, -1) == ".html"), ]

wander.type <- wander[, .(type = str_sub(fullURLId, 1, 3))]  # 提取网页类型
wander.user <- as.data.frame(table(wander.type$type))
wander.user <- wander.user[order(wander.user$Freq, decreasing = TRUE), ]

统计分析网页点击次数

# 统计析网页点击次数
count <- as.numeric(table(all.gzdata$realIP))
click <- as.data.frame(table(count))  # 得到用户点击次数分布情况
click <- click[order(click$Freq, decreasing = TRUE), ]  # 降序排序
click$proportion <- round(click$Freq / sum(click$Freq), 5)  # 计算点击率
head(click, 7)  # 查看前7条数据

# 提取浏览1次网页的数据
count <- count(all.gzdata$realIP)  # realIP出现的频率
colnames(count) <- c("realIP", "Freq")  # 修改列名
count <- count[-which(count$Freq > 1), ]  # 得到浏览次数为1次的用户
click1 <- merge(count, all.gzdata, by = "realIP", all = FALSE)  # 合并数据

# 在浏览1次的前提下, 得到的网页类型分布情况
page <- as.data.frame(table(click1$fullURLId))
page <- page[order(page$Freq, decreasing = TRUE), ]  # 降序排序
page$proportion <- round(page$Freq / sum(page$Freq), 5)  # 计算百分比

# 在浏览1次的前提下, 得到的网页分布情况
click.once <- as.data.frame(table(click1$fullURL))
click.once <- click.once[order(click.once$Freq, decreasing = TRUE), ]  # 排序

统计分析网页排名

# 筛选出以.html为后缀的网页
select.html <- all.gzdata[which(str_sub(all.gzdata$fullURL, -4, -1) == "html"), ]
click.times <- as.data.frame(table(select.html$fullURL))  # 得到fullURL的点击数
click.times <- click.times[order(click.times$Freq, decreasing = TRUE), ]  # 排序

# 从原始数据中提取类型点击次数
website.type <- all.gzdata[, .(realIP, type = str_sub(fullURLId, 1, 3))]
w.t101 <- website.type[which(website.type$type == 101), ]  # 101表示咨询类
nrow(w.t101)  # 咨询类网页的点击次数
length(unique(w.t101$realIP))  # 咨询类的用户数

# 107、301表示知识类
w.t107.301 <- website.type[which(website.type$type == 107 | 
                                   website.type$type == 301), ]
nrow(w.t107.301)  # 知识类网页的点击次数
length(unique(w.t107.301$realIP))  # 知识类的用户数

上面是对用户访问日志的数据预处理，还需要对网页进行分类处理
删除不符合规则的网页

# 设置工作目录
setwd()
all.gzdata <- data.table::fread("./tmp/all_gzdata.csv")  # 快速读取数据
library(plyr)

# 删除原始数据中不符合规则的网页
# 删除中间类型页面，网址带midques
all.gzdata.zj <- all.gzdata[grep("midques", all.gzdata$fullURL), ]  # 2036条记录
all.gzdata <-  all.gzdata[-grep("midques", all.gzdata$fullURL), ]
# 删除法律快车-律师助手登录页面
all.gzdata.kc <- all.gzdata[grep("^法律快车-律师助手$", 
                                 all.gzdata$pageTitle), ]  # 52868条记录
all.gzdata <- all.gzdata[-grep("^法律快车-律师助手$", all.gzdata$pageTitle), ]
# 删除咨询发布成功页面
all.gzdata.fb <- all.gzdata[grep("^咨询发布成功",  
                                 all.gzdata$pageTitle),  ]  # 5220条记录
all.gzdata <- all.gzdata[-grep("^咨询发布成功",  all.gzdata$pageTitle),  ]

# 删除法律快搜页面
all.gzdata.ks <- all.gzdata[grep("http://so.lawtime.cn/", 
                                 all.gzdata$fullURL), ]  # 2017条记录
all.gzdata <- all.gzdata[-grep("http://so.lawtime.cn/", 
                               all.gzdata$fullURL), ]  # 还有775309条记录
# 删除重复的记录数（运行时间较久，可直接使用下面all_gzdata_clear.csv数据）
all.gzdata <- ddply(all.gzdata, .(realIP, timestamp_format, fullURL), 
                    tail, n = 1)  # 739988条记录
# 则重复记录数775309 - 739988 = 35321条
write.csv(all.gzdata, "./tmp/all_gzdata_clear.csv", row.names = FALSE)
all.gzdata <- data.table::fread("./tmp/all_gzdata_clear.csv")  # 快速读取数据

# 提取107开头的网页(知识类)
info107 <- all.gzdata[grep("107", all.gzdata$fullURLId), ]
# 处理带有“？”的网址
info107$fullURL <- gsub("\\?.*", "", info107$fullURL, perl = TRUE)

detach("package:RMySQL")
# 这里采用sqldf包里的sqldf命令，通过SQL进行删选翻页与不翻页的网页。
info107.d <- sqldf::sqldf("select * from info107 where fullurl like '%!_%' escape '!'") 
info107.q <- sqldf::sqldf("select * from info107 where fullurl  not like '%!_%' escape '!' ")

# 查看978851598用户的访问记录
info107.d[which(info107.d$realIP == "978851598"), c(8,11)]

还原翻页网址

# 采用正则匹配那些带有翻页的网址，匹配网址的特点为：数字_页数.html的形式
stri107.p <- regexec("(^.+/\\d+)_\\d{0,2}(.html)", info107.d$fullURL)
# 去除list_1.html形式的网页，以及与其类似的网页
info107.l <- info107.d[-(which(sapply(stri107.p, length) != 3)), ] 
# 提取正则匹配到的数据，并将数据进行粘接
parts107 <- do.call(rbind, regmatches(info107.d$fullURL, stri107.p))
pas107 <- paste0(parts107[, 2], parts107[, 3])

# 将数据进行列组合，并且重新命名，对比处理前后的数据
combine107 <- cbind(parts107, pas107)
colnames(combine107) <- c("fullurl", "temp1", "temp2", "new")

info107.new <- data.frame((combine107[, c(1, 4)]), stringsAsFactors = FALSE)

# 判断处理前后的两列数据以及数据位置是否相同
all.equal(info107.l$fullURL, info107.new$fullurl) 
# 如果返回为TRUE，两种数据集的连接采用如下方式
condata107 <- data.frame(cbind(info107.l[, 1], info107.new[, 2]), 
                         stringsAsFactors = FALSE)
colnames(condata107) <- c("realIP", "fullURL")

# 采用行连接将处理翻页后的数据与没有翻页的数据综合
item.info107 <- rbind(info107.q[, c(1, 11)], condata107)

# 去重数据,以IP和网址划分数据集，选择其相同数据中的最后一条数据
user.info107 <- ddply(item.info107, .(realIP, fullURL), tail, n = 1)
write.csv(user.info107, "./tmp/user_info107.csv", row.names = FALSE)  # 写出数据

划分正确的网页类型

# 重新读取数据
user.info107 <- read.csv("./tmp/user_info107.csv", stringsAsFactors = FALSE)

# 划分正确的网页类型
# 对网址进行处理，以/ 符号划分网址，获得其类别，结果为list型
web <- strsplit(user.info107$fullURL, "/", fixed = TRUE) 
# 对每个LIST型的数据，将其组合成数据框的格式
w.combine107 <- ldply(web, rbind)

# 查看978851598用户的分类情况
user.info107[which(user.info107$realIP == "978851598"), ]
w.combine107[which(user.info107$realIP == "978851598"), ]

# 获取知识列表中婚姻类别的数据以及在原始数据中的位置
hunyi <- w.combine107[which(w.combine107[, 5] == "hunyin"), ]
item.hunyi <- user.info107[row.names(hunyi), ]
write.csv(item.hunyi, "./tmp/item_hunyi.csv", row.names = FALSE)  # 写出数据

# 统计婚姻法类的网页点击情况
count <- data.frame(table(item.hunyi$fullURL))
item.hunyi.time <- as.data.frame(table(count$Freq))  # 得到网页点击次数分布情况
item.hunyi.time <- item.hunyi.time[order(item.hunyi.time$Freq, decreasing = TRUE), ]
head(item.hunyi.time)

预备工作做完后终于开始建模了
构建模型及评价模型

# 设置工作目录并读取数据
setwd()
item.hunyi <- read.csv("./tmp/item_hunyi.csv", stringsAsFactors = FALSE)
library(plyr)
library(recommenderlab)

# 将数据转换为0-1二元型数据，即模型的输入数据集
info <- as(item.hunyi, "binaryRatingMatrix")

# 采用基于物品的协同过滤算法构建模型
info.re <- Recommender(info, method = "IBCF")

# 利用模型对原始数据集进行预测并获得推荐长度为3的结果
info.p <- predict(info.re, info, n = 3) 

# 将结果保存至工作目录下的文件中，需要将结果转换为list型。
# 对list型结果采用sink与print命令将其保存
sink("./tmp/preinfo.txt")
print(as(info.p, "list"))
sink()


# 模型评价
# Random算法每次都随机挑选用户没有产生过行为的物品推荐给当前用户
# Popular算法则按照物品的流行度给用户推荐他没有产生过行为的物品中最热门个物品。
# IBCF算法是基于物品的协同过滤算法
# 模型评价，离线测试
# 将三种算法形成一个算法的list
algorithms <- list("random items" = list(name = "RANDOM", param = NULL),
                   "popular items" = list(name = "POPULAR", param = NULL),
                   "item-based CF" = list(name = "IBCF", param = NULL))

# 将数据以交叉检验划分成K=10份，9份训练，1份测试
# given表示用来进行模型评测的项目数量，（实际数据中只能取1）
info.es <- evaluationScheme(info, method = "cross-validation", k = 10, given = 1)

# 采用算法列表对数据进行模型预测与评价，其推荐值N取3, 5, 10, 15, 20, 30
info.results <- evaluate(info.es, algorithms, n = c(3, 5, 10, 15, 20, 25))

# 画出评价结果的图形
plot(info.results, "prec/rec", legend = "topleft", cex = 0.67)

# 构建F1的评价指标
fvalue <- function(p, r) {
  return(2 * p * r / (p + r))
}

# 求各个评价指标的均值，并将其转换为数据框的形式
info.ind <- ldply(avg(info.results))

# 将指标第一列有关于模型的名字重新命名
info.ind[, 1] <- paste(info.ind[, 1], c(3, 5, 10, 15, 20, 25))

# 选取计算F1的两个指标以及有关于模型的名字
temp.info <- info.ind[, c(1, 6, 7)]

# 计算F1的指标，并综合所有指标
F1 <- fvalue(temp.info[, 2], temp.info[, 3])
info.Fvalue <- cbind(info.ind, F1)

# 将评价指标写入文件中
write.csv(info.Fvalue, "./tmp/infopredict_ind.csv", row.names = FALSE)

关于协同过滤算法
用训练集得到用户-物品矩阵，进一步得到物品之间的关联性（二元选择适合用Jaccard相似系数，相似度计算的方法有：夹角余弦、Jaccard相似系数和相关系数等）。关于推荐算法，本章节中用的是个性化推荐算法ItemCF算法，推荐算法中还有非个性化推荐算法，Random算法（每次都随机挑选用户没有产生过行为的物品推荐给当前用户）、Popular算法（按照物品的流行度给用户推荐其没有产生过行为的物品中最热门的物品）。
协同算法的优点在于利用用户的历史行为数据给用户做推荐，缺点也在于，没用充分考虑用户间的差别，这会影响推荐精度，而且随着时间、产品周期等因素的变化，用户喜好也可能慢慢产生改变，协同算法缺少对近期兴趣的敏感性，或许需要加入一些在时间上的权重算法，最后，对模型的效用评估还是用k-fold CV作为评估方法。