决策树(ID3,C4.5,C5.0,CART算法)以及条件推理决策树R语言实现

news2024/9/21 2:50:38
### 10.2.1 ID3算法基本原理  ###
mtcars2 <- within(mtcars[,c('cyl','vs','am','gear')], {
  am <- factor(am, labels = c("automatic", "manual"))
  vs <- factor(vs, labels = c("V", "S"))
  cyl  <- ordered(cyl)
  gear <- ordered(gear)
})

table(mtcars2$am) # 查看因变量的类别数量

I_am <- -19/32*log2(19/32)-13/32*log2(13/32) # 计算因变量的信息熵
I_am


# 自定义函数计算信息熵、信息增益
information_gain <- function(x,y){
  m1 <- matrix(table(y))
  entropy_y <- sum(-(m1/sum(m1))*log2(m1/sum(m1)))
  t <- table(x,y)
  m <- matrix(t,length(unique(x)),length(unique(y)),
              dimnames = list(levels(x),levels(y)))
  freq <- -rowSums((m/rowSums(m))*log2(m/rowSums(m)))
  entropy <- sum(rowSums(m)*freq/dim(mtcars2)[1],na.rm = T)
  gain <- entropy_y - entropy
  return(c('因变量熵'=entropy_y ,
              '条件熵'=entropy,
              '信息增益' = gain))
}
cat('计算条件变量为cyl的熵及信息增益为:\n')
information_gain(mtcars2$cyl,mtcars2$am)
cat('计算条件变量为vs的熵及信息增益为: \n')
information_gain(mtcars2$vs,mtcars2$am)
cat('计算条件变量为gear的熵及信息增益为: \n')
information_gain(mtcars2$gear,mtcars2$am)

### 10.2.2 C4.5算法  ###
# 自定义函数计算信息熵、信息增益、信息增益率
gain_rate <- function(x,y){
  m0 <- matrix(table(x))
  entropy_x <- sum(-(m0/sum(m0))*log2(m0/sum(m0)))
  m1 <- matrix(table(y))
  entropy_y <- sum(-(m1/sum(m1))*log2(m1/sum(m1)))
  t <- table(x,y)
  m <- matrix(t,length(unique(x)),length(unique(y)),
              dimnames = list(levels(x),levels(y)))
  freq <- -rowSums((m/rowSums(m))*log2(m/rowSums(m)))
  entropy <- sum(rowSums(m)*freq/dim(mtcars2)[1],na.rm = T)
  gain <- entropy_y - entropy
  return(c('自变量熵'=entropy_x ,
           '因变量熵'=entropy_y ,
           '条件熵'=entropy,
           '信息增益' = gain,
           '信息增益率' = gain/entropy_x))
}
cat('计算条件变量为cyl的信息熵及信息增益率为:\n')
round(gain_rate(mtcars2$cyl,mtcars2$am),3)
cat('计算条件变量为vs的信息熵及信息增益率为:\n')
round(gain_rate(mtcars2$vs,mtcars2$am),3)
cat('计算条件变量为gear的信息熵及信息增益率为:\n')
round(gain_rate(mtcars2$gear,mtcars2$am),3)


#### 10.3 R语言实现及案例  ####
#10.3.2 C5.0案例
# 利用iris数据集
# install.packages("C50")
install.packages("C50")
library(C50)
tree_mod <- C5.0(x = iris[,c('Petal.Length','Petal.Width')],
                 y = iris$Species)
tree_mod
summary(tree_mod) # 查看详细信息
plot(tree_mod) # 树模型可视化 
# 对新样本进行预测
pred_class <- predict(tree_mod,newdata = data.frame('Petal.Length' = 2,
                                                    'Petal.Width' = 1)) 
pred_class
pred_prob <- predict(tree_mod,type = 'prob',
                     newdata = data.frame('Petal.Length' = 2,
                                          'Petal.Width' = 1)) 
round(pred_prob,3)

# 10.3.2.4	提高模型的性能 
# library(modeldata)
# data(mlc_churn)
# data(churn)
# 导入数据集
library(modeldata)
library(C50)
#install.packages("modeldata")
data(mlc_churn)
data(churn)
churnTrain <- read.csv('data/churnTrain.csv')
churnTest <- read.csv('data/churnTest.csv')
churnTrain$churn <- as.factor(churnTrain$churn)
churnTest$churn <- as.factor(churnTest$churn)
# 构建模型
treeModel <- C5.0(x = churnTrain[, -20],
                  y = churnTrain$churn)
treeModel1 <- C5.0(x = churnTrain[, -20],
                   y = churnTrain$churn,trials = 10) # 使用10次boosting迭代
# 查看模型对训练数据集的混淆矩阵
(t0 <- table(churnTrain$churn,predict(treeModel,newdata = churnTrain)))
(t1 <- table(churnTrain$churn,predict(treeModel1,newdata = churnTrain)))
cat('普通模型对训练集的预测准确率:',
    paste0(round(sum(diag(t0))*100/sum(t0),2),"%"))
cat('增加boosting的模模型对训练集的预测准确率:',
    paste0(round(sum(diag(t1))*100/sum(t1),2),"%"))

# 查看模型对测试数据集的混淆矩阵
(c0 <- table(churnTest$churn,predict(treeModel,newdata = churnTest)))
(c1 <- table(churnTest$churn,predict(treeModel1,newdata = churnTest)))
cat('普通模型对测试集的预测准确率:',
    paste0(round(sum(diag(c0))*100/sum(c0),2),"%"))
cat('增加boosting的模模型对测试集的预测准确率:',
    paste0(round(sum(diag(c1))*100/sum(c1),2),"%"))

# 定义代价矩阵
cost_mat <- matrix(c(0,1,2,0),nrow = 2)
rownames(cost_mat) <- colnames(cost_mat) <- c("no", "yes")
cost_mat

# 增加代价矩阵的决策树模型
treeModel2 <- C5.0(x = churnTrain[, -20],
                   y = churnTrain$churn,costs = cost_mat)
# 普通模型的预测结果
pred <- predict(treeModel,newdata = churnTrain) 
# 增加代价矩阵模型的预测结果
pred2 <- predict(treeModel2,newdata = churnTrain) 
# 普通模型预测结果的混淆矩阵
table('Actual' = churnTrain$churn,
      'Prediction' = pred)
# 普通模型的查全率
paste0(round(sum(pred=='yes')*100/sum(churnTrain$churn=='yes'),2),'%')
# 增加代价矩阵模型预测结果的混淆矩阵
table('Actual' = churnTrain$churn,
      'Prediction' = pred2)
# 增加代价矩阵模型的查全率
paste0(round(sum(pred2=='yes')*100/sum(churnTrain$churn=='yes'),2),'%')

### 10.3.3  CART案例  ###
# 10.3.3.1 分类树案例
# 分类树构建与预测
library(rpart)
library(rpart.plot)
tree_clf <- rpart(Species ~ Petal.Length + Petal.Width,data = iris)
tree_clf
rpart.plot(tree_clf,extra = 3,digits = 4)
# 对新数据进行预测
predict(tree_clf,newdata = data.frame("Petal.Length" = 5,
                                      "Petal.Width" = 1.5),
        type = 'class')
predict(tree_clf,newdata = data.frame("Petal.Length" = 5,
                                      "Petal.Width" = 1.5))

# 回归树构建与预测
# 构建决策树
insurance <- read.csv('data/insurance.csv')
insurance$children <- insurance$children
train <- insurance[1:1000,] 
test <- insurance[1001:1338,]
tree_reg <- rpart(charges ~ .,data = train)
tree_reg
rpart.plot(tree_reg,type = 4,extra = 1,digits = 4)
# 查看变量重量性,并进行可视化
tree_reg$variable.importance
barplot(tree_reg$variable.importance,
        col='violetred',border = NA,yaxt='n',
        main = '回归树的变量重要性')

# 对测试集进行预测
pred <- predict(tree_reg,newdata = test)
# 查看前六行结果
data.frame(head(test),
           prediction = head(pred))

# 计算R方
tree_r2 <- cor(test$charges,pred)^2 # 回归树的R2
fit <- lm(charges ~ .,data = train)
pred1 <- predict(fit,newdata = test)
lm_r2 <- cor(test$charges,pred1)^2  # 线性回归的R2
data.frame('模型' = c('回归树','线性回归'),
           '判定系数' = round(c(tree_r2,lm_r2),3)) # 查看结果

# 10.3.3.3 决策树的剪枝
library(rpart)
library(rpart.plot)
weather <- read.csv('data/weather.csv') # 导入weather数据集
input <- c("MinTemp", "MaxTemp", "Rainfall",
           "Evaporation", "Sunshine", "WindGustDir",
           "WindGustSpeed", "WindDir9am", "WindDir3pm",
           "WindSpeed9am", "WindSpeed3pm", "Humidity9am",
           "Humidity3pm", "Pressure9am", "Pressure3pm",
           "Cloud9am", "Cloud3pm", "Temp9am", "Temp3pm",
           "RainToday") # 自变量
output <- 'RainTomorrow' # 因变量

# 预剪枝
tree_pre <- rpart(RainTomorrow ~ ., data = weather[,c(input,output)],
                     control = rpart.control(maxdepth = 3)) # 构建决策树
tree_pre # 查看结果

# 后剪枝
tree_clf1 <- rpart(RainTomorrow ~ ., data = weather[,c(input,output)]) # 构建决策树
printcp(tree_clf1) # 查看复杂性信息
plotcp(tree_clf1) # 绘制CP表的信息图

# 对决策树进行剪枝
tree_clf1_pru <- prune(tree_clf1,cp = 0.059) 
tree_clf1_pru

# 10.3.4	 条件推理决策树案例
if(!require(party)) install.packages("party") # 加载party包
library(party)
weather_sub <- weather[,c(input,output)]
weather_sub$WindGustDir <- as.factor(weather_sub$WindGustDir)
weather_sub$WindDir9am <- as.factor(weather_sub$WindDir9am)
weather_sub$WindDir3pm <- as.factor(weather_sub$WindDir3pm)
weather_sub$RainToday<- as.factor(weather_sub$RainToday)
weather_sub$RainTomorrow <- as.factor(weather_sub$RainTomorrow)

tree_ctree <- ctree(RainTomorrow ~ ., data = weather_sub,
                    controls = ctree_control(mincriterion = 0.99))
tree_ctree # 查看模型树
plot(tree_ctree) # 绘制决策树

# 提取数据子集,请查看样本个数及因变量类别占比
weather_sub1 <- weather_sub[weather_sub$Cloud3pm<=6 & weather_sub$Pressure3pm<=1011.8,]
nrow(weather_sub1)
round(prop.table(table(weather_sub1$RainTomorrow)),2)

# 对数据进行预测
pred <- predict(tree_ctree,newdata = weather_sub)
head(pred)

pred_prob <- predict(tree_ctree,type = 'prob',
                     newdata = weather_sub)
head(pred_prob,3)


# 10.3.5 绘制决策边界
library(rpart)
library(rpart.plot)
# 数据处理
iris1 <- iris[,c('Petal.Length','Petal.Width','Species')]
iris1$Species <- as.factor(as.numeric(iris1$Species)) # 将类别变成1、2、3
# 生成深度为1的决策树
tree_clf <- rpart(Species ~ Petal.Length + Petal.Width,data = iris1,
                  control = rpart.control(maxdepth = 1))
tree_clf

# 编写绘制决策边界函数
visualize_classifier <- function(model,X,y,xlim,ylim,type = c('n','n')){
  x1s <- seq(xlim[1],xlim[2],length.out=200)
  x2s <- seq(ylim[1],ylim[2],length.out=200)
  Z <- expand.grid(x1s,x2s)
  colnames(Z) <- colnames(X)
  y_pred <- predict(model,Z,type = 'class')
  y_pred <- matrix(y_pred,length(x1s))
  
  filled.contour(x1s,x2s,y_pred,
                 levels = 1:(length(unique(y))+1),
                 col = RColorBrewer::brewer.pal(length(unique(y)),'Pastel1'),
                 key.axes = FALSE,
                 plot.axes = {axis(1);axis(2);
                   points(X[,1],X[,2],pch=as.numeric(y)+15,col=as.numeric(y)+1,cex=1.5);
                   points(c(2.45,2.45),c(0,3),type = type[1],lwd=2)
                   points(c(2.45,7.5),c(1.75,1.75),type = type[2],lwd=2,lty=2)
                 },
                 xlab = colnames(X)[1],ylab = colnames(X)[2]
  )
}
# 绘制决策边界
visualize_classifier(tree_clf,xlim = c(0,7.5),ylim = c(0,3),
                     X = iris1[,1:2],
                     iris1$Species,
                     type=c('l','n'))

# 生成深度为2的决策树
tree_clf1 <- rpart(Species ~ Petal.Length + Petal.Width,data = iris1,
                  control = rpart.control(maxdepth = 2))
tree_clf1
# 绘制决策边界
visualize_classifier(tree_clf1,xlim = c(0,7.5),ylim = c(0,3),
                     X = iris1[,1:2],
                     iris1$Species,type=c('l','l'))

# 10.4 集成学习及随机森林
# 导入car数据集
car <- read.table("data/car.data",sep = ",")
# 对变量重命名
colnames(car) <- c("buy","main","doors","capacity",
                   "lug_boot","safety","accept")
# 随机选取75%的数据作为训练集建立模型,25%的数据作为测试集用来验证模型
library(caret)
library(ggplot2)
library(lattice)
# 构建训练集的下标集
ind <- createDataPartition(car$accept,times=1,p=0.75,list=FALSE) 
# 构建测试集数据好训练集数据
carTR <- car[ind,]
carTE <- car[-ind,]
carTR<- within(carTR,accept <- factor(accept,levels=c("unacc","acc","good","vgood")))
carTE<- within(carTE,accept <- factor(accept,levels=c("unacc","acc","good","vgood")))


# 使用adabag包中的bagging函数实现bagging算法
#install.packages("adabag")
library(adabag)
bagging.model <- bagging(accept~.,data=carTR)

# 使用adabag包中的boosting函数实现boosting算法
boosting.model <- boosting(accept~.,data=carTR)

# 使用randomForest包中的randomForest函数实现随机森林算法
#install.packages("randomForest")
library(randomForest)
randomForest.model <- randomForest(accept~.,data=carTR,ntree=500,mtry=3)

# 预测结果,并构建混淆矩阵,查看准确率
# 构建result,存放预测结果
result <- data.frame(arithmetic=c("bagging","boosting","随机森林"),
                     errTR=rep(0,3),errTE=rep(0,3))
for(i in 1:3){
  # 预测结果
  carTR_predict <- predict(switch(i,bagging.model,boosting.model,randomForest.model),
                           newdata=carTR) # 训练集数据
  carTE_predict <- predict(switch(i,bagging.model,boosting.model,randomForest.model),
                           newdata=carTE) # 测试集数据
  # 构建混淆矩阵
  tableTR <- table(actual=carTR$accept,
                   predict=switch(i,carTR_predict$class,carTR_predict$class,carTR_predict))
  tableTE <- table(actual=carTE$accept,
                   predict=switch(i,carTE_predict$class,carTE_predict$class,carTE_predict))
  # 计算误差率
  result[i,2] <- paste0(round((sum(tableTR)-sum(diag(tableTR)))*100/sum(tableTR),
                              2),"%")
  result[i,3] <- paste0(round((sum(tableTE)-sum(diag(tableTE)))*100/sum(tableTE),
                              2),"%")
}
# 查看结果
result

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.coloradmin.cn/o/1927860.html

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈,一经查实,立即删除!

相关文章

VMware与centos安装

目录 VM安装 安装centos VM安装 VMware Workstation Pro是VMware&#xff08;威睿公司发布的一袋虚拟机软件&#xff09;&#xff0c;它主要功能是可以给用户在单一的桌面上同时运行不同的操作系统&#xff0c;也是可以进行开发、测试、部署新的应用程序的最佳解决方案。 开始…

力扣144题:二叉树的先序遍历

给你二叉树的根节点 root &#xff0c;返回它节点值的 前序 遍历。 示例 1&#xff1a; 输入&#xff1a;root [1,null,2,3] 输出&#xff1a;[1,2,3]示例 2&#xff1a; 输入&#xff1a;root [] 输出&#xff1a;[]示例 3&#xff1a; 输入&#xff1a;root [1] 输出&am…

跳妹儿学编程之ScratchJr(9):程序控制积木篇—短跑比赛

跳妹儿学编程之ScratchJr(7)&#xff1a;动作积木篇—爸爸去散步 跳妹儿学编程之ScratchJr(8)&#xff1a;外观积木篇—捉迷藏 跳妹儿学编程之ScratchJr(9)&#xff1a;程序控制积木篇—短跑比赛 引言 在之前的一篇文章中&#xff0c;我们了解了ScratchJr的动作积木和外观积…

排序(三)——归并排序(MergeSort)

欢迎来到繁星的CSDN&#xff0c;本期内容主要包括归并排序(MergeSort)的实现 一、归并排序的主要思路 归并排序和上一期讲的快速排序很像&#xff0c;都利用了分治的思想&#xff0c;将一整个数组拆成一个个小数组&#xff0c;排序完毕后进行再排序&#xff0c;直到整个数组排序…

php反序列化--2--PHP反序列化漏洞基础知识

一、什么是反序列化&#xff1f; 反序列化是将序列化的字符串还原为PHP的值的过程。 二、如何反序列化 使用unserialize()函数来执行反序列化操作 代码1&#xff1a; $serializedStr O:8:"stdClass":1:{s:4:"data";s:6:"sample";}; $origina…

autoware.universe源码略读(3.15)--perception:object_merger

autoware.universe源码略读3.15--perception:object_merger Overviewnode&#xff08;enum&#xff09;MSG_COV_IDX&#xff08;Class&#xff09;ObjectAssociationMergerNode&#xff08;Func&#xff09;isUnknownObjectOverlapped&#xff08;Func&#xff09;convertListT…

Directory Opus 13 专业版(Windows 增强型文件管理器)值得购买?

在使用电脑时&#xff0c;总少不了和文件打交道。系统自带的 Explorer 资源管理器功能又非常有限&#xff0c;想要拥有一个多功能文件管理器吗&#xff1f; Directory Opus 是一款老牌多功能文件管理器&#xff0c;能很好地接管 Windows 资源管理器。 接管资源管理器 Directo…

【Linux系列】TEE 命令:同时输出到终端和文件

&#x1f49d;&#x1f49d;&#x1f49d;欢迎来到我的博客&#xff0c;很高兴能够在这里和您见面&#xff01;希望您在这里可以感受到一份轻松愉快的氛围&#xff0c;不仅可以获得有趣的内容和知识&#xff0c;也可以畅所欲言、分享您的想法和见解。 推荐:kwan 的首页,持续学…

(leetcode学习)15. 三数之和

给你一个整数数组 nums &#xff0c;判断是否存在三元组 [nums[i], nums[j], nums[k]] 满足 i ! j、i ! k 且 j ! k &#xff0c;同时还满足 nums[i] nums[j] nums[k] 0 。请 你返回所有和为 0 且不重复的三元组。 注意&#xff1a;答案中不可以包含重复的三元组。 示例 1&a…

java算法day13

java算法day13 104 二叉树的最大深度111 二叉树的最小深度226 翻转二叉树101 对称二叉树100 相同的树 104 二叉树的最大深度 我最开始想到的是用层序遍历。处理每一层然后计数。思路非常的清楚。 迭代法&#xff1a; /*** Definition for a binary tree node.* public class…

Nginx入门到精通三(反向代理1)

下面内容整理自bilibili-尚硅谷-Nginx青铜到王者视频教程 Nginx相关文章 Nginx入门到精通一&#xff08;基本概念介绍&#xff09;-CSDN博客 Nginx入门到精通二&#xff08;安装配置&#xff09;-CSDN博客 Nginx入门到精通三&#xff08;Nginx实例1&#xff1a;反向代理&a…

Linux系统搭建轻量级个人博客VanBlog并一键发布公网远程访问

文章目录 前言1. Linux本地部署2. VanBlog简单使用3. 安装内网穿透4. 创建公网地址5. 创建固定公网地址 前言 今天和大家分享如何在Linux Ubuntu系统搭建一款轻量级个人博客VanBlog&#xff0c;并结合cpolar内网穿透软件生成公网地址&#xff0c;轻松实现随时随地远程访问本地…

Python与自动化脚本编写

Python与自动化脚本编写 Python因其简洁的语法和强大的库支持&#xff0c;成为了自动化脚本编写的首选语言之一。在这篇文章中&#xff0c;我们将探索如何使用Python来编写自动化脚本&#xff0c;以简化日常任务。 一、Python自动化脚本的基础 1. Python在自动化中的优势 Pyth…

内存RAS技术介绍:内存故障预测

故障预测是内存可靠性、可用性和服务性&#xff08;RAS&#xff09;领域中的一个重要方面&#xff0c;旨在提前识别潜在的不可纠正错误&#xff08;UE&#xff09;&#xff0c;以防止系统崩溃或数据丢失。 4.1 错误日志记录与预测基础 错误一般通过Linux内核模块Mcelog记录到…

1.31、基于长短记忆网络(LSTM)的发动机剩余寿命预测(matlab)

1、基于长短记忆网络(LSTM)的发动机剩余寿命预测的原理及流程 基于长短期记忆网络(LSTM)的发动机剩余寿命预测是一种常见的机器学习应用&#xff0c;用于分析和预测发动机或其他设备的剩余可用寿命。下面是LSTM用于发动机剩余寿命预测的原理和流程&#xff1a; 数据收集&#…

实践之K近邻算法实现红酒聚类

前言 K近邻算法是一种用于分类和回归的非参数统计方法&#xff0c;通过计算样本与训练样本的距离&#xff0c;找出最接近的k个样本进行投票来确定分类结果。算法的基本要素包括K值、距离度量和分类决策规则。 K值决定了邻居的影响程度&#xff0c;距离度量反映了样本间的相似度…

python条件

条件语句 if语句 if...else语句 if...elif...else语句 嵌套 is is 是一个身份运算符&#xff0c;用于比较两个对象的身份&#xff0c;即它们在内存中的地址是否相同。这与比较两个对象是否相等的 运算符不同。 运算符比较的是两个对象的值是否相等。 比较对象 比较基本数据…

npm发布的包如何快速在cnpm上使用

npm发布的包如何快速在cnpm上使用 解决方案 前往淘宝npm镜像官网 搜索插件库并点击同步 等待一分钟即可查看最新版本

C++ 类和对象 赋值运算符重载

前言&#xff1a; 在上文我们知道数据类型分为自定义类型和内置类型&#xff0c;当我想用内置类型比较大小是非常容易的但是在C中成员变量都是在类(自定义类型)里面的&#xff0c;那我想给类比较大小那该怎么办呢&#xff1f;这时候运算符重载就出现了 一 运算符重载概念&…

ts踩坑!vue3中defineEmits接收父组件向子组件传递方法,以及方法所需传的参数及类型定义!

使用说明 1、在子组件中调用defineEmits并定义要发射给父组件的方法 const emits defineEmits([‘foldchange’]) 2、使用defineEmits会返回一个方法&#xff0c;使用一个变量emits(变量名随意)去接收 3、在子组件要触发的方法中&#xff0c;调用emits并传入发射给父组件的方法…