ID3决策树（R实现）

叁歲伎倆 2022-06-08 09:49 314阅读 0赞

#### 说明 ####

1.参考文章：[R语言实现决策树ID3算法][R_ID3]  
2.补充了分类预测的函数部分  
3.采用数据框模拟xml文件的方式存储决策树

#### 代码 ####

**训练集（train\_data）**

<table> 
 <thead> 
  <tr> 
   <th>outlook</th> 
   <th>temperature</th> 
   <th>humidity</th> 
   <th>windy</th> 
   <th>play</th> 
  </tr> 
 </thead> 
 <tbody> 
  <tr> 
   <td>sunny</td> 
   <td>hot</td> 
   <td>high</td> 
   <td>FALSE</td> 
   <td>no</td> 
  </tr> 
  <tr> 
   <td>sunny</td> 
   <td>hot</td> 
   <td>high</td> 
   <td>TRUE</td> 
   <td>no</td> 
  </tr> 
  <tr> 
   <td>overcast</td> 
   <td>hot</td> 
   <td>high</td> 
   <td>FALSE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>rainy</td> 
   <td>mild</td> 
   <td>high</td> 
   <td>FALSE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>rainy</td> 
   <td>cool</td> 
   <td>normal</td> 
   <td>FALSE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>rainy</td> 
   <td>cool</td> 
   <td>normal</td> 
   <td>TRUE</td> 
   <td>no</td> 
  </tr> 
  <tr> 
   <td>overcast</td> 
   <td>cool</td> 
   <td>normal</td> 
   <td>TRUE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>sunny</td> 
   <td>mild</td> 
   <td>high</td> 
   <td>FALSE</td> 
   <td>no</td> 
  </tr> 
  <tr> 
   <td>sunny</td> 
   <td>cool</td> 
   <td>normal</td> 
   <td>FALSE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>rainy</td> 
   <td>mild</td> 
   <td>normal</td> 
   <td>FALSE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>sunny</td> 
   <td>mild</td> 
   <td>normal</td> 
   <td>TRUE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>overcast</td> 
   <td>mild</td> 
   <td>high</td> 
   <td>TRUE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>overcast</td> 
   <td>hot</td> 
   <td>normal</td> 
   <td>FALSE</td> 
   <td>yes</td> 
  </tr> 
  <tr> 
   <td>rainy</td> 
   <td>mild</td> 
   <td>high</td> 
   <td>TRUE</td> 
   <td>no</td> 
  </tr> 
 </tbody> 
</table>

测试集也是这个数据集，只是将类标移除了

**模型训练函数**

train<-function(formula,train_data){
      #工具函数
      #计算一列数据的信息熵
      calculateEntropy <- function(train_data){
        t <- table(train_data)    #统计每种结果出现多少次
        sum <- sum(t)       #总次数
        t <- t[t!=0]        #去掉非0
        entropy <- -sum(log2(t/sum)*(t/sum))
    
        return(entropy)
      }
    
      #计算两列数据的信息熵
      calculateEntropy2 <- function(train_data){
        var <- table(train_data[1])
        p <- var/sum(var)
        varnames <- names(var)
        array <- c()
        for(name in varnames){
          array <- c(array,calculateEntropy(subset(train_data,train_data[1]==name,select=2)))
        }
        return(sum(array*p))
      }
    
      #参数准备
      library(Formula)
      result=list(formula=formula,train_data=train_data) #返回结果result是list（包含model）
    
      #解析formula
      rformula=attributes(Formula(formula))
      label=as.character(rformula$lhs) #获得类标列
    
      #获得参与模型的属性
      rhs=as.character(rformula$rhs)
      if(rhs=="."){  #"."代表取所有属性
        attributes=names(train_data)
        attributes=attributes[attributes!=label]
    
      }else{
        rhs=gsub("[N ]","",rhs)#去除空格
        attributes=unlist(strsplit(rhs,"[+]"))#获得属性向量
      }
      result=c(result,label=list(label),attributes=list(attributes))
    
      #初始化model
      entropy=calculateEntropy(train_data[,label])
      model<-data.frame(var="root",value=NA,entropy=entropy,class=NA)
      model$var=as.character(model$var) #否则变成factor，无法输入root以外的节点名称
    
      #核心函数-递归建立决策树
      buildTree <- function(train_data,label,attributes){
        #如果熵为0，停止递归
        if(length(unique(train_data[,label])) == 1){
          model<<-rbind(model,c("leaf",NA,0,unique(train_data[,label])))
          return()
        }
        #如果已经没有别的变量，但还不能完全分类，需要剪枝
        if(length(attributes) == 1){
          t<-table(train_data[,label])
          class=names(t)[t==max(t)]
          entropy=calculateEntropy(train_data[,label])
          model<<-rbind(model,c("leaf",NA,entropy,class))
          return()
        }
        #开始计算
        branch <- ""
        temp <- Inf
        subentropy <- c()
        for(attribute in attributes){
          temp2 <- calculateEntropy2(train_data[,c(attribute,label)])
          if(temp2 < temp){         
            temp <- temp2           #记录最小的信息熵
            branch <- attribute     #最小信息熵对应的类名
          }
        }
    
        attributes <- attributes[attributes!= branch]
        for(value in unlist(unique(train_data[,branch]))){
          model<<-rbind(model,c(branch,value,temp,NA))
          buildTree(subset(train_data,train_data[,branch]==value),label,attributes[attributes !=branch ])
        }
      }
    
      #执行递归函数并返回最终结果
      buildTree(train_data,label,attributes)
      result<-c(result,model=list(model))
      return(result) 
    }

**分类预测函数**  
决策树一般采用xml类格式存储，比较清晰也好用。作者也尝试过在R中使用，但比较麻烦且体现不了R的特色。经过再三考虑决定将决策树存储到数据框中，写入和利用它进行分类都比较方便。  
为了模拟xml的格式，在数据框添加了“root”和”leaf”变量，这在之前的**模型训练函数**中可以看出来，之后遍历并读出每一个leaf对应的分类并赋予符合相应条件的数据。

predict<-function(result,predict_data){ 
      #参数处理（添加序号）,方便之后赋予类标签
      model=result$model
      predict_data=cbind(predict_data,id=as.numeric(rownames(predict_data)))
    
      #初始化类标向量
      labels=vector("character",nrow(predict_data))  
    
      #模拟xml文件，由于无节点概念，用model子集表示节点范围，subset为对应数据子集
      giveLable<-function(model,subset){ 
    
        #无数据提前终止
        if(nrow(subset)==0){
          return()
        }
    
        attribute=model$var[1]
        #判断是否是叶子节点
        if(attribute=="leaf"){
          class=model$class[1]
          temp=labels
          temp[subset$id]=class
          labels<<-temp
          return() 
        }
    
        indexs=which(model$var==attribute)
        values<-model$value[indexs]
    
        #按“节点”分类递归
        for(i in 1:length(indexs)){
          if(i!=length(indexs)){
            tmodel=model[(indexs[i]+1):(indexs[i+1]-1),]
          }else{
            tmodel=model[(indexs[i]+1):nrow(model),]
          }
          tsubset=subset[subset[,attribute]==values[i],]
          giveLable(tmodel,tsubset)
        }
      }
    
      giveLable(model[-1,],predict_data)#"自动"过滤root节点~
      return(labels)
    }

**使用效果**

> result<-train(play~.,train_data)
    > result$model
            var    value           entropy class
    1      root     <NA> 0.940285958670631  <NA>
    2   outlook    sunny 0.693536138896192  <NA>
    3  humidity     high                 0  <NA>
    4      leaf     <NA>                 0    no
    5  humidity   normal                 0  <NA>
    6      leaf     <NA>                 0   yes
    7   outlook overcast 0.693536138896192  <NA>
    8      leaf     <NA>                 0   yes
    9   outlook    rainy 0.693536138896192  <NA>
    10    windy    FALSE                 0  <NA>
    11     leaf     <NA>                 0   yes
    12    windy     TRUE                 0  <NA>
    13     leaf     <NA>                 0    no
    > predict(result,train_data[,1:4])
     [1] "no"  "no"  "yes" "yes" "yes" "no"  "yes" "no"  "yes" "yes" "yes" "yes" "yes" "no" 
    >

#### 存在问题 ####

没有像Java一样使用编号去表示子集，因为这在R中实现起来比较难麻烦，不如直接取数据子集来的方便。但是这样的问题是如果预测数据集过大，将占用较大的内存。  
当然一般情况下决策树的数据集都比较小，因此大部分情况下选择本文中的实现方法都是比较合适的。

[R_ID3]: https://my.oschina.net/u/1047640/blog/305101