干货--C5.0与CART算法实战

在上一期的《浅谈C5.0与CART算法的比较--理论理解》我们详细讲解了有关C5.0决策树和CART决策树的理论知识,包括构造树过程中如何选择节点变量、节点变量的分割点、如何完成剪枝,避免模型的过拟合,从而增强树模型的泛化能力。接下来我们将从实际的案例中来比较两个算法的实现,希望读者在阅读本文时能够再次查看上面提到的那篇理论理解,这将有助于解读后文的落地。

本文实战部分的数据来自于UCI机器学习网站(http://archive.ics.uci.edu/ml/),后文会给出脚本及数据下载的链接。该数据的因变量是反映某银行顾客是否会缴纳一项保证金,总共有45211条记录和16个自变量。各个自变量的含义如下:

age:年龄;

job:工作类型(如行政、管理者、失业等);

marital:婚姻状态(已婚、未婚、离异);

education:教育程度(初等教育、中等教育、高等教育);

default:是否拥有信用卡;

balance:平均年余额;

housing:是否有房贷;

loan:是否有个人贷款;

contact:联系方式(固定电话、手机);

day:最后一次联系的日;

month;最后一次联系的月;

duration;最后一次联系的时长(秒为单位);

campaign:在本次市场活动中联系的次数;

pdays:最后一次联系的时间距离上一次市场活动的间隔天数(-1表示该用户在上一次活动中没有联系);

previous:上一次活动中,联系的次数;

poutcome:上一次市场活动的结果(成功、失败、其他);


接下来我们就利用上面所说的数据集进行建模:

# 加载所需的第三方包

if(!suppressWarnings(require('Hmisc'))){

  install.packages('Hmisc')

  require('Hmisc')

}


if(!suppressWarnings(require('C50'))){

  install.packages('C50')

  require('C50')

}


if(!suppressWarnings(require('rpart'))){

  install.packages('rpart')

  require('rpart')

}


# 读取数据集

mydata <- read.csv(file = file.choose(), sep = ';')

head(mydata)

干货--C5.0与CART算法实战_第1张图片


# 筛选出因子型变量,并对这些变量作统计

factors <- names(mydata)[sapply(mydata,class) == 'factor']

sapply(mydata[,factors], table)

干货--C5.0与CART算法实战_第2张图片

上图为截取的一部分。


# 数据清洗

# 将job中未知职业的记录删除(仅占0.64%),并删除缺失严重的变量poutcome(占82%)。

clear.mydata <- subset(mydata, job != 'unknown', 

                       select = -poutcome)

dim(mydata)

dim(clear.mydata)

0?wx_fmt=png


# 受教育程度中有1857个未知,我们不妨用众数(secondary)替补

education.impute <- ifelse(clear.mydata$education != 'unknown',

                           as.character(clear.mydata$education),

                           'secondary')


# 至少有28%的观测在contact变量上是缺失的,不妨我们按工作种类分组填补。

# 首先将unknown设置为R中的缺失标志NA

clear.mydata$contact <- as.character(clear.mydata$contact)

table(clear.mydata$contact)

0?wx_fmt=png


clear.mydata$contact[clear.mydata$contact == 'unknown'] <- NA

table(clear.mydata$contact, useNA = 'ifany')

0?wx_fmt=png


由于R中没有自带的众数函数,这里我们自定义一个众数函数。

# 自定义众数函数

stat.mode <- function(x, rm.na = TRUE){

  if (rm.na == TRUE){

    y = x[!is.na(x)]

  }

  res = names(table(y))[which.max(table(y))]

  return(res)

}


# 自定义函数,实现分组替补

my.impute <- function(data, category.col = NULL, 

                      miss.col = NULL, method = stat.mode){

  impute.data = NULL

  for(i in as.character(unique(data[,category.col]))){

    sub.data = subset(data, data[,category.col] == i)

    sub.data[,miss.col] = impute(sub.data[,miss.col], method)

    impute.data = c(impute.data, sub.data[,miss.col])

  }

  data[,miss.col] = impute.data

  return(data)

}

其中,category.col 指定所要分组的变量,miss.col指定需要填补的缺失值变量,默认的方法为众数填补。


clear.mydata <- my.impute(clear.mydata, category.col = 'job', 

                          miss.col = 'contact')

table(clear.mydata$contact, useNA = 'ifany')

0?wx_fmt=png

很显然,那些缺失的观测全被替补成了"cellular"沟通方式,说明在各组中联系方式的众数为"cellular"。


# 再将字符串变量转换为因子型变量

clear.mydata$contact <- factor(clear.mydata$contact)

# 数据合并

final.data <- cbind(clear.mydata,education.impute)

final.data <- final.data[,-4]


# 简单的了解一下数据

str(final.data)

干货--C5.0与CART算法实战_第3张图片


summary(final.data)

干货--C5.0与CART算法实战_第4张图片


上面的过程全都是数据预处理的过程,接下来我们要对处理好的数据进行建模和预测:

# 抽样,并将总体分为训练集和测试集

set.seed(1)

index <- sample(1:nrow(final.data), size = 0.75*nrow(final.data))

train <- final.data[index,]

test <- final.data[-index,]


# 大致查看抽样与总体之间是否吻合

prop.table(table(final.data$y))

prop.table(table(train$y))

prop.table(table(test$y))

干货--C5.0与CART算法实战_第5张图片


# 构建C5.0决策树,并对重要变量进行筛选

fit <- C5.0(x = train[,-15], y = train[,15], 

            control = C5.0Control(winnow = TRUE))

summary(fit)

干货--C5.0与CART算法实战_第6张图片

从结果中看,模型选择的重要变量为duration,housing,month,campaign,previous,day,pdays,marital,loan,age,接下来我们就利用这些变量,多模型进行修正。

# 建模并预测

vars <- c('y','duration','housing','month',

          'campaign','previous','day','pdays',

          'marital','loan','age')

train2 <- train[,vars]

test2 <- test[,vars]


# 建模

fit1 <- C5.0(x = train2[,-1], y = train2[,1])

# 预测

pred1 <- predict(fit1, newdata = test2[,-1])

# 混淆矩阵

freq1 <- table(pred1, test2[,1])

freq1

0?wx_fmt=png


# 准确率

accuracy1 <- sum(diag(freq1))/sum(freq1)

accuracy1

# 正例的覆盖率

recall1 <- freq1[2,2]/sum(freq1[,2])

recall1 

干货--C5.0与CART算法实战_第7张图片

虽然模型的准确率达到90%以上,但预测正确的yes在实际的yes中只占了51.8%,即正例的覆盖率并不高,模型的准确性值得怀疑。


C5.0算法可通过错误率和损失矩阵进行剪枝,之前的文章提过,默认的alpha(置信水平)为0.25,当alpha设置低于0.25时,将会进行剪枝。为了确定最佳的alpha值,我们自定一个函数,通过遍历的方式确定alpha。

# 剪枝--基于错误率的剪枝法

err.rate <- function(train, test, y.index = NULL, y.name = NULL){

  alpha <- NULL

  res <- NULL

  if(is.null(y.index)){

    y.index = which(names(train) == y.name)

  }

  for (i in seq(0.25,0.1,-0.01)){

    fit <- C5.0(x = train[,-y.index], y = train[,y.index],

                control = C5.0Control(CF = i))

    pred <- predict(fit, newdata = test[,-y.index])

    freq <- table(pred, test[,y.index])

    accuracy <- sum(diag(freq))/sum(freq)

    alpha <- c(alpha,i)

    res <- c(res,accuracy)

  }

  return(data.frame(alpha,res))

}


err.rate(train2, test2, y.name = 'y')

干货--C5.0与CART算法实战_第8张图片

根据上面的结果,我们确定alpha值为0.23,此时模型的准确率提高了一点点,于是我们基于这个值,再结合损失矩阵再做一次模型的构建和预测。

# 构建损失矩阵(注意必须为矩阵设置行名称和列名称)

costs <- matrix(c(0,4,1,0), ncol = 2, byrow = TRUE,

                dimnames = list(unique(train2$y),unique(train2$y)))

# 同过control参数设置alpha值

fit3 <- C5.0(x = train2[,-1], y = train2[,1], 

            control = C5.0Control(CF = 0.23),

            costs = costs)

# 预测

pred3 <- predict(fit3, newdata = test2[,-1])

freq3 <- table(pred3, test2[,1])

freq3

0?wx_fmt=png

accuracy3 <- sum(diag(freq3))/sum(freq3)

accuracy3

recall3 <- freq3[2,2]/sum(freq3[,2])

recall3

0?wx_fmt=png

模型经过改善后,大大提高了正例的覆盖率,从原来的51.8%提升到目前的80.8%,虽然模型的整体准确率降低了3.4个百分点,但这样的损失在一定程度上是有助于业务市场的活动,因为能够预测到更多的yes对象,就可以对这些群体进行营销,改善业务。


接下来我们再试试CART算法在该数据集上应用:

# 构建CART算法

fit4 <- rpart(y ~ ., data = train2)

# 预测

pred4 <- predict(fit4, newdata = test2[,-1], type = 'class')

# 构建混淆矩阵

freq4 <- table(pred4, test2[,1])

freq4

干货--C5.0与CART算法实战_第9张图片


# 模型准确率

accuracy4 <- sum(diag(freq4))/sum(freq4)

accuracy4

0?wx_fmt=png

发现模型的准确率也挺高的,也在90%,但夸张的是正例的覆盖率只有32.7%,比C5.0模型什么都不做还差很多,这就需要我们对CART算法进行剪枝操作。


首先来看一下模型的cp表,可以通过cp值进行“最小代价复杂度”剪枝:

0?wx_fmt=png

从结果中看,cp值为0.01时,误差率最低,切xerror+xstd也是达到最小,而模型构造的时候默认就是cp=0.01,故暂不需要通过cp值进行剪枝。那看看是否可以通过损失矩阵进一步优化模型:

# 剪枝--基于损失矩阵

costs <- matrix(c(0,1.25,1,0), ncol = 2, byrow = TRUE)

fit5 <- rpart(y ~ ., data = train2, 

              parms = list(loss = costs))

fit5

# 预测

pred5 <- predict(fit5, newdata = test2[,-1], type = 'class')

freq5 <- table(pred5, test2[,1])

freq5

0?wx_fmt=png


accuracy5 <- sum(diag(freq5))/sum(freq5)

accuracy5

0?wx_fmt=png

经过不停的尝试,模型效果一直不够满意,如果损失矩阵设置的大一点就会大失所望。。。如下方所示:

干货--C5.0与CART算法实战_第10张图片

决策树就剩下根节点了,并没有进行树的构造。我怀疑该数据集并不适合使用CART算法进行树的构造。如果有其他观点的欢迎朋友们联系我。


OK,我们这期的实战部分就到这里。欢迎大家多多沟通和交流,通过互相学习,达到取长补短的效果。快要过年了,提前祝福各位网友和朋友2017年新年快乐,心想事成,万事如意!


数据集合脚本链接:

链接:http://pan.baidu.com/s/1ge98tG3 密码:was9


每天进步一点点2015

学习与分享,取长补短,关注小号!

640?wx_fmt=jpeg
长按识别二维码 马上关注

你可能感兴趣的:(干货--C5.0与CART算法实战)