第十章 家用电器用户行为分析与事件识别
10.1 背景与挖掘目标
基于热水器采集的时间序列数据，对不同地区的用户的用水进行识别，根据识别结果比较不同客户群的使用习惯，加深对客户的理解，从而提供个性化产品、改进新产品的智能化研发和制定相应的营销策略。
热水器会间隔两秒采集一次数据
10.2 分析方法与过程
1、数据抽取
对数据集随机抽取200条，每条数据包含12个属性变量。
2、数据探索分析
根据“现场实验设计”，可知两次用水停顿间隔时长一般不大于4分钟，进一步统计用水停顿的时间间隔并做分布直方图，可以分析用户用水停顿时间间隔的规律性，从而划分一次完整用水事件的时间间隔阈值。
3、数据预处理
用“属性规约”和“数值规约”对数据进行删减，留下8个属性变量。进一步筛选哪些状态记录是一个完整的用水事件，通过建立阈值寻优模型，提高在一次完整的用水事件中寻找到特定事件的效率。
（1）读取数据记录，对所有水流量不为0的状态的时间作为序列标记t1；
（2）对序列t1构建其向前时差列和向后时差列，并分别与阈值进行比较，向前时差超过阈值T记为事件开始编号，向后时差超过阈值T记为事件结束编号。
（3）循环执行（2），直到时差列与均值比较完毕，结束事件划分。
一次完整用水事件的划分模型
# 设置工作空间
# 把“数据及程序”文件夹拷贝到F盘下，再用setwd设置工作空间
setwd("F:/数据及程序/chapter10/示例程序")
data <- read.csv("./data/water_heater.csv", header = TRUE)
data$"发生时间" <- strptime(data$"发生时间", "%Y%m%d%H%M%S")
data$eventnum <- as.numeric(row.names(data))
whdata <- data[data$"水流量" != 0, ]
t1 <- whdata$"发生时间"
m <- length(t1) # 得到读取的表格的数据维数
Tm <- 240 # 阀值设置为4分钟(240秒)
t2 <- c(t1[1], t1[1:(m - 1)])
t3 <- c(t1[2:m], t1[m])
td1 <- difftime(t1, t2, units = "secs") # 生成向前时差列
td2 <- difftime(t1, t3, units = "secs") # 生成向后时差列
headornot <- rep(0, m)
endornot <- rep(0, m)
if (whdata$"水流量"[1] != 0) headornot[1] = 1
if (whdata$"水流量"[m] != 0) endornot[m] = 1
for ( i in 2:length(headornot)) { # 寻找连续用水起点
if (abs(td1[i]) >= Tm) {
headornot[i] <- 1
} else {
headornot[i] <- 0
}
}
for ( i in 1:(length(endornot)-1)) { # 寻找连续用水终点
if (abs(td2[i]) >= Tm) {
endornot[i] <- 1
} else {
endornot[i] <- 0
}
}
dividsequence <- data.frame(matrix(NA, sum(headornot == 1), 3))
colnames(dividsequence) <- c("事件序号", "事件起始编号", "事件终止编号")
dividsequence[,1] <- c(1:sum(headornot == 1))
dividsequence[,2] <- whdata$eventnum[which(headornot == 1)]
dividsequence[,3] <- whdata$eventnum[which(endornot == 1)]
write.csv(file = "./tmp/dividsequence.csv", dividsequence, row.names = F)
在进行阈值寻优时需要多次调用以上函数，所以可以封装函数为“divide_event_for_optimization”函数，以供调用。
阈值寻优模型可以解决因时间变化和地域不同导致阈值存在差异的问题。对用户用水数据进行不同阈值划分后，可以得到相应阈值划分的事件个数，画出相应的散点图。
下降趋势明显的说明此阈值范围内的用户停顿习惯较为集中，趋势平缓时说明用户用水习惯趋于稳定，所以可以取平缓段时间的开始作为阈值，既不会将短的用水事件合并，又不会将长的用水事件拆开。
关于如何识别“平缓”这一特征，对每个点取平均斜率，具体的划分和分析事件的专家阈值有关。
用水事件阈值寻优模型
# 设置工作空间
# 把“数据及程序”文件夹拷贝到F盘下，再用setwd设置工作空间
setwd("F:/数据及程序/chapter10/示例程序")
data <- read.csv("./data/water_heater.csv", header = TRUE)
Tm <- seq(2, 8, by = 0.25) * 60 # 阀值设置为2到8分钟，每0.25分钟取次值，存在Tm向量中
divide_event_for_optimization <- function(x, data) {
# x:划分事件的阈值;data:输入数据
data$"发生时间" <- strptime(data$"发生时间", "%Y%m%d%H%M%S")
data$eventnum <- as.numeric(row.names(data))
whdata <- data[data$"水流量" != 0, ]
t1 <- whdata$"发生时间"
m <- length(t1) # 得到读取的表格的数据维数
t2 <- c(t1[1], t1[1:(m - 1)])
t3 <- c(t1[2:m], t1[m])
td1 <- difftime(t1, t2, units = "secs") # 生成向前时差列
td2 <- difftime(t1, t3, units = "secs") # 生成向后时差列
headornot <- rep(0, m)
endornot <- rep(0, m)
if (whdata$"水流量"[1] != 0)headornot[1] = 1
if (whdata$"水流量"[m] != 0)endornot[m] = 1
for ( i in 2:length(headornot)) { # 寻找连续用水起点
if (abs(td1[i]) >= x) {
headornot[i] <- 1
} else {
headornot[i] <- 0
}
}
return(sum(headornot))
}
div <- data.frame(matrix(0, length(Tm), 2))
div[, 1] <- Tm
for ( i in 1:length(Tm)) { # 分别求各阀值对应的事件数，并存于div中
div[i,2] <- divide_event_for_optimization(Tm[i], data)
}
# 求最优阀值
k <- rep(0,length(Tm))
for (i in 1 : (length(Tm) - 4)) {
k[i] <- (abs((div[i + 1, 2] - div[i, 2]) / 0.25) +
abs((div[i + 2, 2] - div[i, 2]) / 0.5) +
abs((div[i + 3, 2] - div[i, 2]) / 0.75) +
abs((div[i + 4, 2] - div[i, 2]) / 1)) / 4
} # k[i]记录每个阈值对应的平均斜率
kl <- length(k)
if (any(k[-c((kl - 3):kl)] <= 1) == TRUE) {
Tm_best <- k[-c((kl - 3):kl)][k[-c((kl - 3):kl)] <= 1][1]
} else {
Tm_best <- Tm[which(k == min(k[-c((kl - 3):kl)]))][1] / 60
if (Tm_best >= 5) Tm_best = 4
}
Tm_best
运行程序后可以知道最优阈值是4min。
属性构造
用水行为可以构造四类指标：时长指标、频率指标、用水量化指标、用水波动指标。这部分的指标构建专业性以及与业务的综合性很强，书中有做详细阐述。然后对研究事件的实际属性做粗筛选，得到“候选洗浴事件”。在对数据预处理后，得到数据实例表：
在训练神经网络时，选取了“候选洗浴事件”的11个属性作为网络的输入，训练BP神经网络时给定输出信号（用户日志中的是否为洗浴事件）。在训练BP神经网络时，对参数进行了寻优，发现两个隐藏层的神经网络训练效果较好，其中两个隐层节点分别为17、10时训练效果较好。
# 设置工作空间
# 把“数据及程序”文件夹拷贝到F盘下，再用setwd设置工作空间
setwd("F:/数据及程序/chapter10/示例程序")
# 训练BP神经网络
# install.packages("AMORE")
library(AMORE)
# 读入训练数据
data <- read.csv("./data/train_neural_network_data.csv", head = TRUE)
for (i in 5:16) {
data[, i] <- as.numeric(as.vector(data)[, i])
} # 将数据处理为可用的numeric类型
inputdata <- data[, 6:16] # 记录被选择用来作为输入的属性
outputdata <- data[, 5] # 记录教师信号所在列
n.neurons <- c(11, 17, 10, 1) # 11个输入，2个隐层，分别为17、10个节点，1个输出
net <- newff(n.neurons, learning.rate.global = 0.05, momentum.global = 0.5,
error.criterium = "LMS", Stao = NA, hidden.layer = "tansig",
output.layer = "purelin", method = "ADAPTgdwm") # 创建神经网络，其中：
# 学习率为0.05,采用最小均方LMS作为测量误差函数,隐层间传递函数设置为tansig,
# 输出层传递函数为purelin,优先考虑ADAPTgdwm训练方法
result <- train(net, inputdata, outputdata, error.criterium = "LMS",
report = TRUE, show.step = 100, n.shows = 5)
# 保存训练好的BP神经网络
save(result,file = "./tmp/result.RData")
模型检验训练好模型后，将某用户记录的一周属性数据输入，可以从用户的用水日志中识别用户的“洗浴事件”。
# 设置工作空间
# 把“数据及程序”文件夹拷贝到F盘下，再用setwd设置工作空间
setwd("F:/数据及程序/chapter10/示例程序")
library(AMORE)
# BP神经网络模型测试
# 参数初始化
netfile <- "./tmp/result.RData" # 神经网络模型存储路径
testdatafile <- "./data/test_neural_network_data.csv" # 待验证数据存储路径
testoutputfile <- "./tmp/test_output_data.csv" # 测试数据模型输出文件
data <- read.csv(testdatafile, header = TRUE) # 读入验证数据
for (i in 5:16) {
data[, i] <- as.numeric(as.vector(data)[, i])
} # 将数据处理为可用的numeric类型
targetoutput <- data[, 5] # 记录教师信号所在列
# 神经网络仿真
testdata <- data[,6:16] # 神经网络输入形式
load(netfile) # 载入训练好的神经网络模型
output <- sim(result$net, testdata) # 仿真得到输出结果
output[which(output <= 0)] <- -1
output[which(output > 0)] <- 1
# 计算正确率
sum <- 0
for (i in 1:nrow(data)) {
if (output[i] == targetoutput[i]) {
sum <- sum + 1
}
}
cat("正确率", sum / nrow(data))
# 导出数据
temp <- data.frame(matrix(NA, nrow(data), 6))
temp[, 1:5] <- data[1:5]
temp[, 6] <- output
colnames(temp) <- c("热水事件", "起始数据编号", "终止数据编号", "开始时间",
"根据日志判断是否为洗浴（1表示是，-1表示否）",
"神经网络判断是否为洗浴")
write.csv(temp, file = testoutputfile, quote = F, row.names = F)
332
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
